├── .project ├── src ├── .properties ├── Spec-Gtk │ ├── package.st │ ├── SpColumnAlignmentLeft.extension.st │ ├── SpColumnAlignmentCenter.extension.st │ ├── SpColumnAlignmentRight.extension.st │ ├── SpColumnAlignment.extension.st │ ├── SpExecutableLayout.extension.st │ ├── KMSingleKeyCombination.extension.st │ ├── SpProgressBarState.extension.st │ ├── SpLayoutWidgetAlignment.extension.st │ ├── SpLayoutWidgetAlignmentEnd.extension.st │ ├── SpTPresenterBuilder.extension.st │ ├── KMModifiedKeyCombination.extension.st │ ├── SpAbstractSelectionMode.extension.st │ ├── SpCollectionListModel.extension.st │ ├── SpFixedProgressBarState.extension.st │ ├── SpLayoutWidgetAlignmentStart.extension.st │ ├── SpTreeSingleSelectionMode.extension.st │ ├── GtkModalWindowAdapter.class.st │ ├── SpLayoutWidgetAlignmentCenter.extension.st │ ├── SpTreeMultipleSelectionMode.extension.st │ ├── SpIndeterminatedProgressBarState.extension.st │ ├── SpAbstractPresenter.extension.st │ ├── SpLayoutDirection.extension.st │ ├── GtkBaseStore.extension.st │ ├── KMKeyCombinationSequence.extension.st │ ├── CmUICommandGroupDisplayStrategy.extension.st │ ├── CmUIDisplayAsGroup.extension.st │ ├── CmUIDisplayAsSubMenu.extension.st │ ├── GtkMenuBarAdapter.class.st │ ├── GtkFastTableAdapter.class.st │ ├── SpVerticalLayoutDirection.extension.st │ ├── GtkMenuBaseAdapter.class.st │ ├── SpHorizontalLayoutDirection.extension.st │ ├── SpCommandGroup.extension.st │ ├── SpWindowPresenter.extension.st │ ├── GtkTDisconnectSelectionEvents.trait.st │ ├── GtkTreeTableColumnBuilder.class.st │ ├── GtkToolbarButtonAdapter.class.st │ ├── SpMultipleSelectionMode.extension.st │ ├── KMKeyCombination.extension.st │ ├── GtkContainerAdapter.class.st │ ├── GtkColumnViewAdapterHeaderFactory.class.st │ ├── GtkAdapterBindings.class.st │ ├── KMKeyCombinationChoice.extension.st │ ├── SpSingleSelectionMode.extension.st │ ├── SpPresenter.extension.st │ ├── KMPlatformSpecificKeyCombination.extension.st │ ├── SpApplication.extension.st │ ├── GtkWindowAdapter.class.st │ ├── SpGtkWidgetPresenter.class.st │ ├── ObservableValueHolder.extension.st │ ├── GtkButtonAdapter.class.st │ ├── GtkButtonBarAdapter.class.st │ ├── GtkSpinnerAdapter.class.st │ ├── GtkAdapterActionDrawingAreaManager.class.st │ ├── GtkGtkWidgetAdapter.class.st │ ├── GtkAdapterActionCodeManager.class.st │ ├── GtkListViewAdapterItemFactory.class.st │ ├── GtkAdapterMultiSelection.class.st │ ├── GtkFrameAdapter.class.st │ ├── GtkToolbarPopoverButtonAdapter.class.st │ ├── GtkAdapterSingleSelection.class.st │ ├── GtkTHaveWrappingScrollBars.trait.st │ ├── GtkDropListAdapterItemFactory.class.st │ ├── GtkProgressBarAdapter.class.st │ ├── GtkColumnedListAdapter.class.st │ ├── GtkSwitchAdapter.class.st │ ├── GtkActionBarAdapter.class.st │ ├── GtkOverlayAdapter.class.st │ ├── GMenuCompound.class.st │ ├── SpLabelPresenter.extension.st │ ├── GtkImageAdapter.class.st │ ├── GtkAdapterSelection.class.st │ ├── GtkListViewAdapterDataStore.class.st │ ├── GtkAdapterActionTextInputFieldManager.class.st │ ├── GtkScrollableAdapter.class.st │ ├── GtkColumnViewAdapterItemFactory.class.st │ ├── GtkActionShortcutInstaller.class.st │ ├── GtkTreeColumnViewExpanderAdapterItemFactory.class.st │ ├── GtkToolbarAdapter.class.st │ ├── GtkRichTextAdapter.class.st │ ├── GtkToolbarToggleButtonAdapter.class.st │ ├── GtkDropDownAdapterLabelFactory.class.st │ ├── GtkTreeColumnViewAdapterItemFactory.class.st │ ├── GtkListViewAdapterHeaderFactory.class.st │ ├── GtkToggleButtonAdapter.class.st │ ├── GtkTTableAccessing.trait.st │ ├── GtkTreeListViewAdapterDataStore.class.st │ ├── GtkToolbarBaseButtonAdapter.class.st │ ├── GtkMenuAdapter.class.st │ ├── GtkAthensAdapter.class.st │ ├── GtkTreeAdapter.class.st │ ├── GtkActionInstaller.class.st │ ├── GtkToolbarMenuButtonAdapter.class.st │ ├── SpGtkBannerPresenter.class.st │ ├── GtkCheckBoxAdapter.class.st │ ├── GtkStatusBarAdapter.class.st │ ├── GtkLinkAdapter.class.st │ ├── SpDropListItemPresenter.class.st │ ├── GtkTreeListViewAdapterItemFactory.class.st │ ├── GtkTSortableColumns.trait.st │ ├── GtkActionVisitor.class.st │ ├── GtkGridAdapter.class.st │ ├── GtkAdapterActionTextManager.class.st │ ├── GtkSliderAdapter.class.st │ ├── GtkRadioButtonAdapter.class.st │ ├── GMenuItemActionCompound.class.st │ ├── GtkNumberInputFieldAdapter.class.st │ ├── GtkMenuButtonAdapter.class.st │ ├── GtkMenuBuilder.class.st │ ├── GtkTabAdapter.class.st │ ├── GtkActionMenuBuilder.class.st │ ├── SpGtkBannerContentPresenter.class.st │ ├── GtkTSpecialCharacterForList.trait.st │ ├── GtkBaseListAdapter.class.st │ ├── GtkTSpecialCharacterForText.trait.st │ ├── GtkTableColumnVisitor.class.st │ ├── GtkBaseButtonAdapter.class.st │ ├── GtkAbstractListAdapter.class.st │ ├── GtkSearchInputFieldAdapter.class.st │ ├── GtkBoxAdapter.class.st │ └── GtkLabelAdapter.class.st ├── Spec-Gtk-Code │ ├── package.st │ ├── TextAttribute.extension.st │ ├── TextColor.extension.st │ ├── TextFontReference.extension.st │ ├── SpApplication.extension.st │ ├── ManifestSpecGtkCode.class.st │ ├── GtkTextTagTable.extension.st │ ├── GtkCodeUserAction.class.st │ ├── SpCodePresenter.extension.st │ ├── TextEmphasis.extension.st │ ├── GtkTextStyleTag.class.st │ ├── GtkCodeCompletionEngine.class.st │ ├── GtkCodeTagTableManager.class.st │ └── GtkCodeSmartCharacters.class.st ├── Spec-Gtk-Frame │ ├── package.st │ ├── SpFramePresenter.class.st │ └── GtkFrameLayoutAdapter.class.st ├── Spec-Gtk-Pillar │ ├── package.st │ └── GtkTextStyleTagsVisitor.class.st ├── BaselineOfSpecGtk │ ├── package.st │ └── BaselineOfSpecGtk.class.st ├── Spec-Gtk-Code-Diff │ ├── package.st │ ├── SpDiffPresenter.extension.st │ ├── GtkPatchSideBySideVisitorTest.class.st │ ├── GtkDiffAdapter.class.st │ ├── GtkPatchLineVisitor.class.st │ ├── GtkPatchSideBySideVisitor.class.st │ └── GtkPatchSideBySideAdapter.class.st ├── Spec-Gtk-Alexandrie │ ├── package.st │ └── GtkAlexandrieAdapter.class.st ├── Spec-Gtk-Keybindings │ ├── package.st │ ├── KMKeyCombination.extension.st │ ├── KeyboardKey.extension.st │ └── GtkKMDispatcher.class.st ├── Spec-GtkBackendTests │ ├── package.st │ ├── GtkBaseWindowAdapter.extension.st │ ├── GtkListAdapterSingleSelectionTest.class.st │ ├── SpMockMenu.extension.st │ ├── GtkListAdapterTest.class.st │ ├── GtkColumnedListAdapterSingleSelectionTest.class.st │ ├── GtkAdapterTestCase.class.st │ ├── GtkPopoverAdapterTest.class.st │ ├── GtkTextStyleVisitorTest.class.st │ ├── GtkWindowAdapterTest.class.st │ ├── GtkComponentListAdapterTest.class.st │ ├── GtkBackendForTest.class.st │ └── GtkKMDispatcherTest.class.st ├── Spec-Gtk-Morphic-Adapter │ ├── package.st │ ├── PluggableMenuSpec.extension.st │ ├── GtkGenericAdapter.class.st │ ├── PluggableMenuItemSpec.extension.st │ ├── GtkMorphAdapter.class.st │ └── GtkPaginatorAdapter.class.st └── Spec-Gtk-TestLayoutLeaks │ ├── package.st │ ├── SpLayoutLeaksTest.class.st │ └── SpLayoutLeaksTestFromSelection.class.st └── README.md /.project: -------------------------------------------------------------------------------- 1 | { 2 | 'srcDirectory' : 'src' 3 | } -------------------------------------------------------------------------------- /src/.properties: -------------------------------------------------------------------------------- 1 | { 2 | #format : #tonel 3 | } -------------------------------------------------------------------------------- /src/Spec-Gtk/package.st: -------------------------------------------------------------------------------- 1 | Package { #name : 'Spec-Gtk' } 2 | -------------------------------------------------------------------------------- /src/Spec-Gtk-Code/package.st: -------------------------------------------------------------------------------- 1 | Package { #name : 'Spec-Gtk-Code' } 2 | -------------------------------------------------------------------------------- /src/Spec-Gtk-Frame/package.st: -------------------------------------------------------------------------------- 1 | Package { #name : 'Spec-Gtk-Frame' } 2 | -------------------------------------------------------------------------------- /src/Spec-Gtk-Pillar/package.st: -------------------------------------------------------------------------------- 1 | Package { #name : #'Spec-Gtk-Pillar' } 2 | -------------------------------------------------------------------------------- /src/BaselineOfSpecGtk/package.st: -------------------------------------------------------------------------------- 1 | Package { #name : 'BaselineOfSpecGtk' } 2 | -------------------------------------------------------------------------------- /src/Spec-Gtk-Code-Diff/package.st: -------------------------------------------------------------------------------- 1 | Package { #name : 'Spec-Gtk-Code-Diff' } 2 | -------------------------------------------------------------------------------- /src/Spec-Gtk-Alexandrie/package.st: -------------------------------------------------------------------------------- 1 | Package { #name : 'Spec-Gtk-Alexandrie' } 2 | -------------------------------------------------------------------------------- /src/Spec-Gtk-Keybindings/package.st: -------------------------------------------------------------------------------- 1 | Package { #name : #'Spec-Gtk-Keybindings' } 2 | -------------------------------------------------------------------------------- /src/Spec-GtkBackendTests/package.st: -------------------------------------------------------------------------------- 1 | Package { #name : 'Spec-GtkBackendTests' } 2 | -------------------------------------------------------------------------------- /src/Spec-Gtk-Morphic-Adapter/package.st: -------------------------------------------------------------------------------- 1 | Package { #name : 'Spec-Gtk-Morphic-Adapter' } 2 | -------------------------------------------------------------------------------- /src/Spec-Gtk-TestLayoutLeaks/package.st: -------------------------------------------------------------------------------- 1 | Package { #name : #'Spec-Gtk-TestLayoutLeaks' } 2 | -------------------------------------------------------------------------------- /src/Spec-Gtk-Code/TextAttribute.extension.st: -------------------------------------------------------------------------------- 1 | Extension { #name : 'TextAttribute' } 2 | 3 | { #category : '*Spec-Gtk-Code' } 4 | TextAttribute >> acceptTag: aTag [ 5 | ] 6 | -------------------------------------------------------------------------------- /src/Spec-Gtk/SpColumnAlignmentLeft.extension.st: -------------------------------------------------------------------------------- 1 | Extension { #name : 'SpColumnAlignmentLeft' } 2 | 3 | { #category : '*Spec-Gtk' } 4 | SpColumnAlignmentLeft >> asXAlign [ 5 | 6 | ^ 0.0 7 | ] 8 | -------------------------------------------------------------------------------- /src/Spec-Gtk-Code/TextColor.extension.st: -------------------------------------------------------------------------------- 1 | Extension { #name : 'TextColor' } 2 | 3 | { #category : '*Spec-Gtk-Code' } 4 | TextColor >> acceptTag: aTag [ 5 | 6 | aTag foreground: self color 7 | ] 8 | -------------------------------------------------------------------------------- /src/Spec-Gtk/SpColumnAlignmentCenter.extension.st: -------------------------------------------------------------------------------- 1 | Extension { #name : 'SpColumnAlignmentCenter' } 2 | 3 | { #category : '*Spec-Gtk' } 4 | SpColumnAlignmentCenter >> asXAlign [ 5 | 6 | ^ 0.5 7 | ] 8 | -------------------------------------------------------------------------------- /src/Spec-Gtk/SpColumnAlignmentRight.extension.st: -------------------------------------------------------------------------------- 1 | Extension { #name : 'SpColumnAlignmentRight' } 2 | 3 | { #category : '*Spec-Gtk' } 4 | SpColumnAlignmentRight >> asXAlign [ 5 | 6 | ^ 1.0 7 | ] 8 | -------------------------------------------------------------------------------- /src/Spec-Gtk/SpColumnAlignment.extension.st: -------------------------------------------------------------------------------- 1 | Extension { #name : 'SpColumnAlignment' } 2 | 3 | { #category : '*Spec-Gtk' } 4 | SpColumnAlignment >> asXAlign [ 5 | 6 | self subclassResponsibility 7 | ] 8 | -------------------------------------------------------------------------------- /src/Spec-Gtk/SpExecutableLayout.extension.st: -------------------------------------------------------------------------------- 1 | Extension { #name : 'SpExecutableLayout' } 2 | 3 | { #category : '*Spec-Gtk' } 4 | SpExecutableLayout >> forGtkLayoutRebuild [ 5 | 6 | ^ self adapter 7 | ] 8 | -------------------------------------------------------------------------------- /src/Spec-Gtk/KMSingleKeyCombination.extension.st: -------------------------------------------------------------------------------- 1 | Extension { #name : 'KMSingleKeyCombination' } 2 | 3 | { #category : '*Spec-Gtk' } 4 | KMSingleKeyCombination >> spGtkCurrentCharacter [ 5 | 6 | ^ key 7 | ] 8 | -------------------------------------------------------------------------------- /src/Spec-Gtk/SpProgressBarState.extension.st: -------------------------------------------------------------------------------- 1 | Extension { #name : 'SpProgressBarState' } 2 | 3 | { #category : '*Spec-Gtk' } 4 | SpProgressBarState >> applyTo: anAdapter [ 5 | 6 | self subclassResponsibility 7 | ] 8 | -------------------------------------------------------------------------------- /src/Spec-Gtk/SpLayoutWidgetAlignment.extension.st: -------------------------------------------------------------------------------- 1 | Extension { #name : 'SpLayoutWidgetAlignment' } 2 | 3 | { #category : '*Spec-Gtk' } 4 | SpLayoutWidgetAlignment >> asGtkAlign [ 5 | 6 | ^ self subclassResponsibility 7 | ] 8 | -------------------------------------------------------------------------------- /src/Spec-Gtk/SpLayoutWidgetAlignmentEnd.extension.st: -------------------------------------------------------------------------------- 1 | Extension { #name : 'SpLayoutWidgetAlignmentEnd' } 2 | 3 | { #category : '*Spec-Gtk' } 4 | SpLayoutWidgetAlignmentEnd >> asGtkAlign [ 5 | 6 | ^ GtkAlign GTK_ALIGN_END 7 | ] 8 | -------------------------------------------------------------------------------- /src/Spec-Gtk/SpTPresenterBuilder.extension.st: -------------------------------------------------------------------------------- 1 | Extension { #name : 'SpTPresenterBuilder' } 2 | 3 | { #category : '*Spec-Gtk' } 4 | SpTPresenterBuilder >> newGtkWidget [ 5 | 6 | ^ self instantiate: SpGtkWidgetPresenter 7 | ] 8 | -------------------------------------------------------------------------------- /src/Spec-Gtk/KMModifiedKeyCombination.extension.st: -------------------------------------------------------------------------------- 1 | Extension { #name : 'KMModifiedKeyCombination' } 2 | 3 | { #category : '*Spec-Gtk' } 4 | KMModifiedKeyCombination >> spGtkCurrentCharacter [ 5 | 6 | ^ self character key 7 | ] 8 | -------------------------------------------------------------------------------- /src/Spec-Gtk/SpAbstractSelectionMode.extension.st: -------------------------------------------------------------------------------- 1 | Extension { #name : 'SpAbstractSelectionMode' } 2 | 3 | { #category : '*Spec-Gtk' } 4 | SpAbstractSelectionMode >> gtkAdapterCompanion [ 5 | 6 | ^ self subclassResponsibility 7 | ] 8 | -------------------------------------------------------------------------------- /src/Spec-Gtk/SpCollectionListModel.extension.st: -------------------------------------------------------------------------------- 1 | Extension { #name : 'SpCollectionListModel' } 2 | 3 | { #category : '*Spec-Gtk' } 4 | SpCollectionListModel >> unsubscribe: anObject [ 5 | 6 | self announcer unsubscribe: anObject 7 | ] 8 | -------------------------------------------------------------------------------- /src/Spec-Gtk/SpFixedProgressBarState.extension.st: -------------------------------------------------------------------------------- 1 | Extension { #name : 'SpFixedProgressBarState' } 2 | 3 | { #category : '*Spec-Gtk' } 4 | SpFixedProgressBarState >> applyTo: anAdapter [ 5 | 6 | ^ anAdapter fixedValue: self value 7 | ] 8 | -------------------------------------------------------------------------------- /src/Spec-Gtk/SpLayoutWidgetAlignmentStart.extension.st: -------------------------------------------------------------------------------- 1 | Extension { #name : 'SpLayoutWidgetAlignmentStart' } 2 | 3 | { #category : '*Spec-Gtk' } 4 | SpLayoutWidgetAlignmentStart >> asGtkAlign [ 5 | 6 | ^ GtkAlign GTK_ALIGN_START 7 | ] 8 | -------------------------------------------------------------------------------- /src/Spec-Gtk/SpTreeSingleSelectionMode.extension.st: -------------------------------------------------------------------------------- 1 | Extension { #name : 'SpTreeSingleSelectionMode' } 2 | 3 | { #category : '*Spec-Gtk' } 4 | SpTreeSingleSelectionMode >> gtkAdapterCompanion [ 5 | 6 | ^ GtkAdapterSingleSelection 7 | ] 8 | -------------------------------------------------------------------------------- /src/Spec-Gtk/GtkModalWindowAdapter.class.st: -------------------------------------------------------------------------------- 1 | Class { 2 | #name : 'GtkModalWindowAdapter', 3 | #superclass : 'GtkDialogWindowAdapter', 4 | #category : 'Spec-Gtk-Adapter-Window', 5 | #package : 'Spec-Gtk', 6 | #tag : 'Adapter-Window' 7 | } 8 | -------------------------------------------------------------------------------- /src/Spec-Gtk/SpLayoutWidgetAlignmentCenter.extension.st: -------------------------------------------------------------------------------- 1 | Extension { #name : 'SpLayoutWidgetAlignmentCenter' } 2 | 3 | { #category : '*Spec-Gtk' } 4 | SpLayoutWidgetAlignmentCenter >> asGtkAlign [ 5 | 6 | ^ GtkAlign GTK_ALIGN_CENTER 7 | ] 8 | -------------------------------------------------------------------------------- /src/Spec-Gtk/SpTreeMultipleSelectionMode.extension.st: -------------------------------------------------------------------------------- 1 | Extension { #name : 'SpTreeMultipleSelectionMode' } 2 | 3 | { #category : '*Spec-Gtk' } 4 | SpTreeMultipleSelectionMode >> gtkAdapterCompanion [ 5 | 6 | ^ GtkAdapterMultiSelection 7 | ] 8 | -------------------------------------------------------------------------------- /src/Spec-Gtk/SpIndeterminatedProgressBarState.extension.st: -------------------------------------------------------------------------------- 1 | Extension { #name : 'SpIndeterminatedProgressBarState' } 2 | 3 | { #category : '*Spec-Gtk' } 4 | SpIndeterminatedProgressBarState >> applyTo: anAdapter [ 5 | 6 | ^ anAdapter indeterminateValue 7 | ] 8 | -------------------------------------------------------------------------------- /src/Spec-Gtk/SpAbstractPresenter.extension.st: -------------------------------------------------------------------------------- 1 | Extension { #name : 'SpAbstractPresenter' } 2 | 3 | { #category : '*Spec-Gtk' } 4 | SpAbstractPresenter >> openModalWithParent: aParent [ 5 | 6 | ^ self asModalWindow 7 | owner: aParent; 8 | open 9 | ] 10 | -------------------------------------------------------------------------------- /src/Spec-Gtk/SpLayoutDirection.extension.st: -------------------------------------------------------------------------------- 1 | Extension { #name : 'SpLayoutDirection' } 2 | 3 | { #category : '*Spec-Gtk' } 4 | SpLayoutDirection >> applyDirectionConstraintsTo: aWidget constraints: constraints in: layout [ 5 | 6 | self subclassResponsibility 7 | ] 8 | -------------------------------------------------------------------------------- /src/Spec-Gtk/GtkBaseStore.extension.st: -------------------------------------------------------------------------------- 1 | Extension { #name : 'GtkBaseStore' } 2 | 3 | { #category : '*Spec-Gtk' } 4 | GtkBaseStore >> roots: aCollection [ 5 | "Compatibility with GtkTreeDataStore, it should just be used when removing... hence 6 | not really needed." 7 | ] 8 | -------------------------------------------------------------------------------- /src/Spec-Gtk/KMKeyCombinationSequence.extension.st: -------------------------------------------------------------------------------- 1 | Extension { #name : 'KMKeyCombinationSequence' } 2 | 3 | { #category : '*Spec-Gtk' } 4 | KMKeyCombinationSequence >> withAllKeyCombinationsDo: aBlock [ 5 | 6 | self error: 'Spec-Gtk does not supports shortcut sequences for the moment' 7 | ] 8 | -------------------------------------------------------------------------------- /src/Spec-Gtk-Code/TextFontReference.extension.st: -------------------------------------------------------------------------------- 1 | Extension { #name : 'TextFontReference' } 2 | 3 | { #category : '*Spec-Gtk-Code' } 4 | TextFontReference >> acceptTag: aTag [ 5 | aTag 6 | fontFamily: font familyName 7 | size: font pointSize 8 | weight: font weightValue 9 | ] 10 | -------------------------------------------------------------------------------- /src/Spec-Gtk/CmUICommandGroupDisplayStrategy.extension.st: -------------------------------------------------------------------------------- 1 | Extension { #name : 'CmUICommandGroupDisplayStrategy' } 2 | 3 | { #category : '*Spec-Gtk' } 4 | CmUICommandGroupDisplayStrategy >> appendGroup: aMenu label: aLabel to: parentMenu in: aVisitor [ 5 | 6 | self subclassResponsibility 7 | ] 8 | -------------------------------------------------------------------------------- /src/Spec-Gtk/CmUIDisplayAsGroup.extension.st: -------------------------------------------------------------------------------- 1 | Extension { #name : 'CmUIDisplayAsGroup' } 2 | 3 | { #category : '*Spec-Gtk' } 4 | CmUIDisplayAsGroup >> appendGroup: aMenu label: aLabel to: parentMenu in: aVisitor [ 5 | 6 | ^ aVisitor 7 | appendSection: aMenu 8 | label: aLabel 9 | to: parentMenu 10 | ] 11 | -------------------------------------------------------------------------------- /src/Spec-Gtk/CmUIDisplayAsSubMenu.extension.st: -------------------------------------------------------------------------------- 1 | Extension { #name : 'CmUIDisplayAsSubMenu' } 2 | 3 | { #category : '*Spec-Gtk' } 4 | CmUIDisplayAsSubMenu >> appendGroup: aMenu label: aLabel to: parentMenu in: aVisitor [ 5 | 6 | ^ aVisitor 7 | appendSubmenu: aMenu 8 | label: aLabel 9 | to: parentMenu 10 | ] 11 | -------------------------------------------------------------------------------- /src/Spec-Gtk/GtkMenuBarAdapter.class.st: -------------------------------------------------------------------------------- 1 | Class { 2 | #name : 'GtkMenuBarAdapter', 3 | #superclass : 'GtkMenuAdapter', 4 | #category : 'Spec-Gtk-Adapter-Menu', 5 | #package : 'Spec-Gtk', 6 | #tag : 'Adapter-Menu' 7 | } 8 | 9 | { #category : 'accessing' } 10 | GtkMenuBarAdapter >> widgetClass [ 11 | 12 | ^ GtkMenuBar 13 | ] 14 | -------------------------------------------------------------------------------- /src/Spec-Gtk/GtkFastTableAdapter.class.st: -------------------------------------------------------------------------------- 1 | Class { 2 | #name : 'GtkFastTableAdapter', 3 | #superclass : 'GtkListAdapter', 4 | #category : 'Spec-Gtk-Adapter-List', 5 | #package : 'Spec-Gtk', 6 | #tag : 'Adapter-List' 7 | } 8 | 9 | { #category : 'deprecation' } 10 | GtkFastTableAdapter class >> isDeprecated [ 11 | 12 | ^ true 13 | ] 14 | -------------------------------------------------------------------------------- /src/Spec-Gtk/SpVerticalLayoutDirection.extension.st: -------------------------------------------------------------------------------- 1 | Extension { #name : 'SpVerticalLayoutDirection' } 2 | 3 | { #category : '*Spec-Gtk' } 4 | SpVerticalLayoutDirection >> applyDirectionConstraintsTo: aWidget constraints: constraints in: layout [ 5 | 6 | ^ layout 7 | applyVerticalConstraintsTo: aWidget 8 | constraints: constraints 9 | ] 10 | -------------------------------------------------------------------------------- /src/Spec-Gtk/GtkMenuBaseAdapter.class.st: -------------------------------------------------------------------------------- 1 | Class { 2 | #name : 'GtkMenuBaseAdapter', 3 | #superclass : 'GtkAdapter', 4 | #category : 'Spec-Gtk-Adapter-Menu', 5 | #package : 'Spec-Gtk', 6 | #tag : 'Adapter-Menu' 7 | } 8 | 9 | { #category : 'building' } 10 | GtkMenuBaseAdapter >> addModelTo: gtkWidget [ 11 | 12 | self subclassResponsibility 13 | ] 14 | -------------------------------------------------------------------------------- /src/Spec-Gtk/SpHorizontalLayoutDirection.extension.st: -------------------------------------------------------------------------------- 1 | Extension { #name : 'SpHorizontalLayoutDirection' } 2 | 3 | { #category : '*Spec-Gtk' } 4 | SpHorizontalLayoutDirection >> applyDirectionConstraintsTo: aWidget constraints: constraints in: layout [ 5 | 6 | ^ layout 7 | applyHorizontalConstraintsTo: aWidget 8 | constraints: constraints 9 | ] 10 | -------------------------------------------------------------------------------- /src/Spec-Gtk-Code/SpApplication.extension.st: -------------------------------------------------------------------------------- 1 | Extension { #name : 'SpApplication' } 2 | 3 | { #category : '*Spec-Gtk-Code' } 4 | SpApplication >> styleScheme [ 5 | 6 | ^ self ensureConfiguration styleScheme 7 | ] 8 | 9 | { #category : '*Spec-Gtk-Code' } 10 | SpApplication >> syntaxHighlightTheme [ 11 | 12 | ^ self ensureConfiguration syntaxHighlightTheme 13 | ] 14 | -------------------------------------------------------------------------------- /src/Spec-Gtk/SpCommandGroup.extension.st: -------------------------------------------------------------------------------- 1 | Extension { #name : 'SpCommandGroup' } 2 | 3 | { #category : '*Spec-Gtk' } 4 | SpCommandGroup >> id [ 5 | 6 | ^ String streamContents: [ :stream | 7 | | parts | 8 | parts := (self name ifNil: [ 'unknown' ]) substrings. 9 | stream << parts first asLowercase. 10 | parts allButFirstDo: [ :each | stream << each capitalized ] ] 11 | ] 12 | -------------------------------------------------------------------------------- /src/Spec-Gtk-Code/ManifestSpecGtkCode.class.st: -------------------------------------------------------------------------------- 1 | " 2 | I store metadata for this package. These meta data are used by other tools such as the SmalllintManifestChecker and the critics Browser 3 | " 4 | Class { 5 | #name : 'ManifestSpecGtkCode', 6 | #superclass : 'PackageManifest', 7 | #category : 'Spec-Gtk-Code-Manifest', 8 | #package : 'Spec-Gtk-Code', 9 | #tag : 'Manifest' 10 | } 11 | -------------------------------------------------------------------------------- /src/Spec-GtkBackendTests/GtkBaseWindowAdapter.extension.st: -------------------------------------------------------------------------------- 1 | Extension { #name : 'GtkBaseWindowAdapter' } 2 | 3 | { #category : '*Spec-GtkBackendTests' } 4 | GtkBaseWindowAdapter >> windowIsResizable [ 5 | 6 | ^ self widgetDo: [ :w | w isResizable ] 7 | ] 8 | 9 | { #category : '*Spec-GtkBackendTests' } 10 | GtkBaseWindowAdapter >> windowSize [ 11 | 12 | ^ self widgetDo: [ :w | w defaultSize ] 13 | ] 14 | -------------------------------------------------------------------------------- /src/Spec-Gtk/SpWindowPresenter.extension.st: -------------------------------------------------------------------------------- 1 | Extension { #name : 'SpWindowPresenter' } 2 | 3 | { #category : '*Spec-Gtk' } 4 | SpWindowPresenter >> inform: aString [ 5 | 6 | self withAdapterDo: [ :anAdapter | 7 | anAdapter inform: aString ] 8 | ] 9 | 10 | { #category : '*Spec-Gtk' } 11 | SpWindowPresenter >> informError: aString [ 12 | 13 | self withAdapterDo: [ :anAdapter | 14 | anAdapter notifyError: aString ] 15 | ] 16 | -------------------------------------------------------------------------------- /src/Spec-Gtk/GtkTDisconnectSelectionEvents.trait.st: -------------------------------------------------------------------------------- 1 | Trait { 2 | #name : 'GtkTDisconnectSelectionEvents', 3 | #category : 'Spec-Gtk-Adapter-Table', 4 | #package : 'Spec-Gtk', 5 | #tag : 'Adapter-Table' 6 | } 7 | 8 | { #category : 'private' } 9 | GtkTDisconnectSelectionEvents >> disconnectSelectionEventsOf: aWidget during: aBlock [ 10 | 11 | aWidget selection 12 | blockCallback: GChangedCallback signalName 13 | during: aBlock 14 | ] 15 | -------------------------------------------------------------------------------- /src/Spec-Gtk/GtkTreeTableColumnBuilder.class.st: -------------------------------------------------------------------------------- 1 | Class { 2 | #name : 'GtkTreeTableColumnBuilder', 3 | #superclass : 'GtkTableColumnBuilder', 4 | #category : 'Spec-Gtk-Adapter-Table', 5 | #package : 'Spec-Gtk', 6 | #tag : 'Adapter-Table' 7 | } 8 | 9 | { #category : 'private' } 10 | GtkTreeTableColumnBuilder >> nodeFromPath: path [ 11 | 12 | ^ self model itemAtPath: ((path substrings: ':') collect: [ :each | each asNumber + 1 ]) 13 | ] 14 | -------------------------------------------------------------------------------- /src/Spec-Gtk/GtkToolbarButtonAdapter.class.st: -------------------------------------------------------------------------------- 1 | Class { 2 | #name : 'GtkToolbarButtonAdapter', 3 | #superclass : 'GtkToolbarBaseButtonAdapter', 4 | #category : 'Spec-Gtk-Adapter-Toolbar', 5 | #package : 'Spec-Gtk', 6 | #tag : 'Adapter-Toolbar' 7 | } 8 | 9 | { #category : 'building' } 10 | GtkToolbarButtonAdapter >> newWidget [ 11 | 12 | ^ super newWidget 13 | addClass: 'image-button'; 14 | addClass: 'toolbar-button'; 15 | yourself 16 | ] 17 | -------------------------------------------------------------------------------- /src/Spec-Gtk/SpMultipleSelectionMode.extension.st: -------------------------------------------------------------------------------- 1 | Extension { #name : 'SpMultipleSelectionMode' } 2 | 3 | { #category : '*Spec-Gtk' } 4 | SpMultipleSelectionMode >> gtkAdapterCompanion [ 5 | 6 | ^ GtkAdapterMultiSelection 7 | ] 8 | 9 | { #category : '*Spec-Gtk' } 10 | SpMultipleSelectionMode >> unsubscribeOuterContextReceiver: anObject [ 11 | 12 | (self observablePropertyNamed: #selectedIndexes) unsubscribeOuterContextReceiver: anObject. 13 | ] 14 | -------------------------------------------------------------------------------- /src/Spec-Gtk/KMKeyCombination.extension.st: -------------------------------------------------------------------------------- 1 | Extension { #name : 'KMKeyCombination' } 2 | 3 | { #category : '*Spec-Gtk' } 4 | KMKeyCombination >> isForPlatform [ 5 | 6 | ^ self platform = #all or: [ self platform = OSPlatform current platformFamily ] 7 | ] 8 | 9 | { #category : '*Spec-Gtk' } 10 | KMKeyCombination >> spGtkCurrentCharacter [ 11 | 12 | ^ '' 13 | ] 14 | 15 | { #category : '*Spec-Gtk' } 16 | KMKeyCombination >> withAllKeyCombinationsDo: aBlock [ 17 | 18 | aBlock value: self 19 | ] 20 | -------------------------------------------------------------------------------- /src/Spec-Gtk/GtkContainerAdapter.class.st: -------------------------------------------------------------------------------- 1 | Class { 2 | #name : 'GtkContainerAdapter', 3 | #superclass : 'GtkAdapter', 4 | #category : 'Spec-Gtk-Adapter', 5 | #package : 'Spec-Gtk', 6 | #tag : 'Adapter' 7 | } 8 | 9 | { #category : 'protocol' } 10 | GtkContainerAdapter >> add: anAdapter [ 11 | 12 | self widgetDo: [ :w | 13 | w packStart: anAdapter widget ] 14 | ] 15 | 16 | { #category : 'building' } 17 | GtkContainerAdapter >> newWidget [ 18 | 19 | ^ GtkBox newVertical 20 | show; 21 | yourself 22 | ] 23 | -------------------------------------------------------------------------------- /src/Spec-Gtk/GtkColumnViewAdapterHeaderFactory.class.st: -------------------------------------------------------------------------------- 1 | " 2 | Header factory for to be used with `GtkColumnViewAdapter` 3 | " 4 | Class { 5 | #name : 'GtkColumnViewAdapterHeaderFactory', 6 | #superclass : 'GtkListViewAdapterHeaderFactory', 7 | #category : 'Spec-Gtk-Adapter-ListView', 8 | #package : 'Spec-Gtk', 9 | #tag : 'Adapter-ListView' 10 | } 11 | 12 | { #category : 'private' } 13 | GtkColumnViewAdapterHeaderFactory >> itemAt: aPosition [ 14 | 15 | ^ (self presenter columns at: aPosition) title ifNil: [ '' ] 16 | ] 17 | -------------------------------------------------------------------------------- /src/Spec-Gtk/GtkAdapterBindings.class.st: -------------------------------------------------------------------------------- 1 | Class { 2 | #name : 'GtkAdapterBindings', 3 | #superclass : 'SpAdapterBindings', 4 | #category : 'Spec-Gtk-Adapter', 5 | #package : 'Spec-Gtk', 6 | #tag : 'Adapter' 7 | } 8 | 9 | { #category : 'initialize' } 10 | GtkAdapterBindings >> allAdapters [ 11 | 12 | ^ GtkAdapter allAdapters 13 | ] 14 | 15 | { #category : 'initialize' } 16 | GtkAdapterBindings >> initializeBindings [ 17 | 18 | GtkAdapter allSubclasses 19 | reject: #isAbstract 20 | thenDo: [ :each | 21 | bindings 22 | at: each adaptingName 23 | put: each name ] 24 | ] 25 | -------------------------------------------------------------------------------- /src/Spec-Gtk/KMKeyCombinationChoice.extension.st: -------------------------------------------------------------------------------- 1 | Extension { #name : 'KMKeyCombinationChoice' } 2 | 3 | { #category : '*Spec-Gtk' } 4 | KMKeyCombinationChoice >> spGtkCurrentCharacter [ 5 | | candidates | 6 | 7 | candidates := shortcuts 8 | collect: [ :each | each spGtkCurrentCharacter ] 9 | thenSelect: [ :each | each isNotNil ]. 10 | 11 | ^ candidates 12 | ifEmpty: [ nil ] 13 | ifNotEmpty: [ candidates first ] 14 | ] 15 | 16 | { #category : '*Spec-Gtk' } 17 | KMKeyCombinationChoice >> withAllKeyCombinationsDo: aBlock [ 18 | 19 | shortcuts do: [ :each | 20 | aBlock value: each ] 21 | ] 22 | -------------------------------------------------------------------------------- /src/Spec-GtkBackendTests/GtkListAdapterSingleSelectionTest.class.st: -------------------------------------------------------------------------------- 1 | Class { 2 | #name : 'GtkListAdapterSingleSelectionTest', 3 | #superclass : 'GtkAbstractListAdapterSingleSelectionTest', 4 | #category : 'Spec-GtkBackendTests', 5 | #package : 'Spec-GtkBackendTests' 6 | } 7 | 8 | { #category : 'running' } 9 | GtkListAdapterSingleSelectionTest >> classToTest [ 10 | ^ SpListPresenter 11 | ] 12 | 13 | { #category : 'running' } 14 | GtkListAdapterSingleSelectionTest >> setUp [ 15 | 16 | super setUp. 17 | 18 | window := presenter 19 | beSingleSelection; 20 | items: #(10 20 30); 21 | openWithSpec. 22 | ] 23 | -------------------------------------------------------------------------------- /src/Spec-Gtk/SpSingleSelectionMode.extension.st: -------------------------------------------------------------------------------- 1 | Extension { #name : 'SpSingleSelectionMode' } 2 | 3 | { #category : '*Spec-Gtk' } 4 | SpSingleSelectionMode >> gtkAdapterCompanion [ 5 | 6 | ^ GtkAdapterSingleSelection 7 | ] 8 | 9 | { #category : '*Spec-Gtk' } 10 | SpSingleSelectionMode >> unsubscribe: anObject [ 11 | 12 | (self observablePropertyNamed: #selectedIndex) unsubscribe: anObject. 13 | 14 | ] 15 | 16 | { #category : '*Spec-Gtk' } 17 | SpSingleSelectionMode >> unsubscribeOuterContextReceiver: anObject [ 18 | 19 | (self observablePropertyNamed: #selectedIndex) unsubscribeOuterContextReceiver: anObject. 20 | ] 21 | -------------------------------------------------------------------------------- /src/Spec-Gtk-Code/GtkTextTagTable.extension.st: -------------------------------------------------------------------------------- 1 | Extension { #name : 'GtkTextTagTable' } 2 | 3 | { #category : '*Spec-Gtk-Code' } 4 | GtkTextTagTable class >> newForCode [ 5 | 6 | ^ self newForCode: (SHRBTextStyler initialTextAttributesForPixelHeight: 1) 7 | 8 | 9 | ] 10 | 11 | { #category : '*Spec-Gtk-Code' } 12 | GtkTextTagTable class >> newForCode: attrArray [ 13 | | table | 14 | 15 | table := self new. 16 | attrArray keysAndValuesDo: [ :aName :attributes | | tag | 17 | tag := GtkTextTag newName: aName asString. 18 | attributes do: [ :each | each acceptTag: tag ]. 19 | table add: tag ]. 20 | 21 | ^ table 22 | ] 23 | -------------------------------------------------------------------------------- /src/Spec-Gtk/SpPresenter.extension.st: -------------------------------------------------------------------------------- 1 | Extension { #name : 'SpPresenter' } 2 | 3 | { #category : '*Spec-Gtk' } 4 | SpPresenter >> forGtkLayoutRebuild [ 5 | 6 | ^ self 7 | ] 8 | 9 | { #category : '*Spec-Gtk' } 10 | SpPresenter >> isActivatable [ 11 | "When being included as part of a *class:SpComponentListPresenter*, presenters can define 12 | whether they are activatable or not (default: ==true==)." 13 | 14 | ^ true 15 | ] 16 | 17 | { #category : '*Spec-Gtk' } 18 | SpPresenter >> isSelectable [ 19 | "When being included as part of a *class:SpComponentListPresenter*, presenters can define 20 | whether they are selectable or not (default: ==true==)." 21 | 22 | ^ true 23 | ] 24 | -------------------------------------------------------------------------------- /src/Spec-Gtk/KMPlatformSpecificKeyCombination.extension.st: -------------------------------------------------------------------------------- 1 | Extension { #name : 'KMPlatformSpecificKeyCombination' } 2 | 3 | { #category : '*Spec-Gtk' } 4 | KMPlatformSpecificKeyCombination >> isForPlatform [ 5 | 6 | ^ self platform = #all or: [ self platform = OSPlatform current platformFamily ] 7 | ] 8 | 9 | { #category : '*Spec-Gtk' } 10 | KMPlatformSpecificKeyCombination >> key [ 11 | 12 | ^ self shortcut key 13 | ] 14 | 15 | { #category : '*Spec-Gtk' } 16 | KMPlatformSpecificKeyCombination >> spGtkCurrentCharacter [ 17 | 18 | ^ (self platform = #all or: [ self platform = OSPlatform current platformFamily ]) 19 | ifTrue: [ self shortcut spGtkCurrentCharacter ] 20 | ifFalse: [ nil ] 21 | ] 22 | -------------------------------------------------------------------------------- /src/Spec-Gtk-TestLayoutLeaks/SpLayoutLeaksTest.class.st: -------------------------------------------------------------------------------- 1 | Class { 2 | #name : #SpLayoutLeaksTest, 3 | #superclass : #TestCase, 4 | #category : #'Spec-Gtk-TestLayoutLeaks' 5 | } 6 | 7 | { #category : #tests } 8 | SpLayoutLeaksTest >> testOpen [ 9 | 10 | | win testPresenter oldAdapters finder | 11 | finder := GtkLeakFinder new. 12 | finder start. 13 | win := SpLayoutLeaksTestPresenter openGtk. 14 | testPresenter := win presenter. 15 | oldAdapters := testPresenter adapters. 16 | testPresenter swapLayouts. 17 | 30 timesRepeat: [ Smalltalk garbageCollect ]. 18 | self assert: (oldAdapters allSatisfy: [ :e | e isNil ]). 19 | win close. 20 | finder stop. 21 | self assert: finder leaks isEmpty. 22 | ] 23 | -------------------------------------------------------------------------------- /src/Spec-Gtk/SpApplication.extension.st: -------------------------------------------------------------------------------- 1 | Extension { #name : 'SpApplication' } 2 | 3 | { #category : '*Spec-Gtk' } 4 | SpApplication >> addCSSProviderFromPath: aPath [ 5 | 6 | self ensureConfiguration addCSSProviderFromPath: aPath 7 | ] 8 | 9 | { #category : '*Spec-Gtk' } 10 | SpApplication >> addCSSProviderFromReference: aPath [ 11 | 12 | self ensureConfiguration addCSSProviderFromReference: aPath 13 | ] 14 | 15 | { #category : '*Spec-Gtk' } 16 | SpApplication >> addCSSProviderFromString: aPath [ 17 | 18 | self ensureConfiguration addCSSProviderFromString: aPath 19 | ] 20 | 21 | { #category : '*Spec-Gtk' } 22 | SpApplication >> defaultConfigurationForGtk [ 23 | 24 | ^ SpGtkConfiguration new 25 | ] 26 | -------------------------------------------------------------------------------- /src/Spec-Gtk/GtkWindowAdapter.class.st: -------------------------------------------------------------------------------- 1 | Class { 2 | #name : 'GtkWindowAdapter', 3 | #superclass : 'GtkBaseWindowAdapter', 4 | #category : 'Spec-Gtk-Adapter-Window', 5 | #package : 'Spec-Gtk', 6 | #tag : 'Adapter-Window' 7 | } 8 | 9 | { #category : 'private' } 10 | GtkWindowAdapter class >> adapterClass [ 11 | 12 | ^ self allSubclasses 13 | detect: [ :each | each canBeUsed ] 14 | ifNone: [ self ] 15 | ] 16 | 17 | { #category : 'private' } 18 | GtkWindowAdapter class >> canBeUsed [ 19 | 20 | ^ false 21 | ] 22 | 23 | { #category : 'instance creation' } 24 | GtkWindowAdapter class >> new [ 25 | 26 | "Then, I can use variants (like Adwaita based windows)" 27 | ^ self adapterClass 28 | basicNew 29 | initialize 30 | ] 31 | -------------------------------------------------------------------------------- /src/Spec-Gtk/SpGtkWidgetPresenter.class.st: -------------------------------------------------------------------------------- 1 | Class { 2 | #name : 'SpGtkWidgetPresenter', 3 | #superclass : 'SpAbstractWidgetPresenter', 4 | #instVars : [ 5 | 'widget' 6 | ], 7 | #category : 'Spec-Gtk-Widgets', 8 | #package : 'Spec-Gtk', 9 | #tag : 'Widgets' 10 | } 11 | 12 | { #category : 'specs' } 13 | SpGtkWidgetPresenter class >> adapterName [ 14 | 15 | ^ #GtkWidgetAdapter 16 | ] 17 | 18 | { #category : 'documentation' } 19 | SpGtkWidgetPresenter class >> documentFactoryMethodSelector [ 20 | 21 | ^ #newGtkWidget 22 | ] 23 | 24 | { #category : 'accessing' } 25 | SpGtkWidgetPresenter >> widget [ 26 | ^ widget 27 | ] 28 | 29 | { #category : 'accessing' } 30 | SpGtkWidgetPresenter >> widget: anObject [ 31 | widget := anObject 32 | ] 33 | -------------------------------------------------------------------------------- /src/Spec-Gtk-Morphic-Adapter/PluggableMenuSpec.extension.st: -------------------------------------------------------------------------------- 1 | Extension { #name : 'PluggableMenuSpec' } 2 | 3 | { #category : '*Spec-Gtk-Morphic-Adapter' } 4 | PluggableMenuSpec >> asMenuBarPresenter [ 5 | 6 | ^ SpMenuBarPresenter new 7 | addGroup: [ :group | 8 | self items do: [ :each | 9 | group addMenuItem: each asMenuItemPresenter ] ] 10 | ] 11 | 12 | { #category : '*Spec-Gtk-Morphic-Adapter' } 13 | PluggableMenuSpec >> asMenuPresenter [ 14 | | presenter | 15 | 16 | presenter := SpMenuPresenter new. 17 | (self items groupByRuns: [ :each | each separator = true ]) do: [ :eachGroup | 18 | presenter addGroup: [ :group | 19 | eachGroup do: [ :each | 20 | group addMenuItem: each asMenuItemPresenter ] ] ]. 21 | ^ presenter 22 | ] 23 | -------------------------------------------------------------------------------- /src/Spec-GtkBackendTests/SpMockMenu.extension.st: -------------------------------------------------------------------------------- 1 | Extension { #name : 'SpMockMenu' } 2 | 3 | { #category : '*Spec-GtkBackendTests' } 4 | SpMockMenu >> children [ 5 | "hack for test. 6 | In populate-popup events (textview, entry) the callback will enter here 7 | as a prove I'm in the right callback. 8 | I answer empty to avoid after processing, but I'm already fine" 9 | 10 | self shown: true. 11 | 12 | ^ #() 13 | ] 14 | 15 | { #category : '*Spec-GtkBackendTests' } 16 | SpMockMenu >> connectDestroy: aBlock [ 17 | 18 | 19 | ] 20 | 21 | { #category : '*Spec-GtkBackendTests' } 22 | SpMockMenu >> popupAtPointer: event [ 23 | 24 | self shown: true 25 | ] 26 | 27 | { #category : '*Spec-GtkBackendTests' } 28 | SpMockMenu >> showAll [ 29 | ] 30 | -------------------------------------------------------------------------------- /src/Spec-GtkBackendTests/GtkListAdapterTest.class.st: -------------------------------------------------------------------------------- 1 | Class { 2 | #name : 'GtkListAdapterTest', 3 | #superclass : 'GtkAdapterTestCase', 4 | #category : 'Spec-GtkBackendTests', 5 | #package : 'Spec-GtkBackendTests' 6 | } 7 | 8 | { #category : 'running' } 9 | GtkListAdapterTest >> classToTest [ 10 | 11 | ^ SpListPresenter 12 | ] 13 | 14 | { #category : 'running' } 15 | GtkListAdapterTest >> setUp [ 16 | 17 | super setUp. 18 | 19 | presenter 20 | items: Collection withAllSubclasses; 21 | display: [ :each | each name ]. 22 | 23 | ] 24 | 25 | { #category : 'tests' } 26 | GtkListAdapterTest >> testListWithNoIcons [ 27 | 28 | self openInstance. 29 | self 30 | assert: presenter adapter innerWidget model numberOfColumns 31 | equals: 1 32 | ] 33 | -------------------------------------------------------------------------------- /src/Spec-Gtk-Code/GtkCodeUserAction.class.st: -------------------------------------------------------------------------------- 1 | Class { 2 | #name : 'GtkCodeUserAction', 3 | #superclass : 'Object', 4 | #instVars : [ 5 | 'registerChange' 6 | ], 7 | #category : 'Spec-Gtk-Code-Base', 8 | #package : 'Spec-Gtk-Code', 9 | #tag : 'Base' 10 | } 11 | 12 | { #category : 'testing' } 13 | GtkCodeUserAction >> hasChanged [ 14 | 15 | ^ registerChange > 0 16 | 17 | 18 | ] 19 | 20 | { #category : 'initialization' } 21 | GtkCodeUserAction >> initialize [ 22 | 23 | super initialize. 24 | self reset 25 | ] 26 | 27 | { #category : 'accessing' } 28 | GtkCodeUserAction >> registerChange [ 29 | 30 | registerChange := registerChange + 1 31 | ] 32 | 33 | { #category : 'accessing' } 34 | GtkCodeUserAction >> reset [ 35 | 36 | registerChange := 0 37 | ] 38 | -------------------------------------------------------------------------------- /src/Spec-Gtk-Code/SpCodePresenter.extension.st: -------------------------------------------------------------------------------- 1 | Extension { #name : 'SpCodePresenter' } 2 | 3 | { #category : '*Spec-Gtk-Code' } 4 | SpCodePresenter >> highlightSearchText: aBoolean [ 5 | 6 | self withAdapterDo: [ :anAdapter | anAdapter highlightSearchText: aBoolean ] 7 | ] 8 | 9 | { #category : '*Spec-Gtk-Code' } 10 | SpCodePresenter >> searchBackward [ 11 | 12 | self withAdapterDo: [ :anAdapter | anAdapter searchBackward ] 13 | ] 14 | 15 | { #category : '*Spec-Gtk-Code' } 16 | SpCodePresenter >> searchForward [ 17 | 18 | self withAdapterDo: [ :anAdapter | anAdapter searchForward ] 19 | ] 20 | 21 | { #category : '*Spec-Gtk-Code' } 22 | SpCodePresenter >> searchText: aString [ 23 | 24 | self withAdapterDo: [ :anAdapter | anAdapter searchText: aString ] 25 | ] 26 | -------------------------------------------------------------------------------- /src/Spec-Gtk-Morphic-Adapter/GtkGenericAdapter.class.st: -------------------------------------------------------------------------------- 1 | Class { 2 | #name : 'GtkGenericAdapter', 3 | #superclass : 'GtkAdapter', 4 | #instVars : [ 5 | 'morph' 6 | ], 7 | #category : 'Spec-Gtk-Morphic-Adapter', 8 | #package : 'Spec-Gtk-Morphic-Adapter' 9 | } 10 | 11 | { #category : 'instance creation' } 12 | GtkGenericAdapter class >> morph: aMorph [ 13 | 14 | ^ self new morph: aMorph 15 | ] 16 | 17 | { #category : 'accessing' } 18 | GtkGenericAdapter >> morph [ 19 | 20 | ^ morph 21 | ] 22 | 23 | { #category : 'accessing' } 24 | GtkGenericAdapter >> morph: anObject [ 25 | 26 | morph := anObject 27 | ] 28 | 29 | { #category : 'building' } 30 | GtkGenericAdapter >> newWidget [ 31 | 32 | ^ GtkScrolledWindow newWidget: (GtkMorphView newMorph: self morph) 33 | ] 34 | -------------------------------------------------------------------------------- /src/Spec-Gtk/ObservableValueHolder.extension.st: -------------------------------------------------------------------------------- 1 | Extension { #name : 'ObservableValueHolder' } 2 | 3 | { #category : '*Spec-Gtk' } 4 | ObservableValueHolder >> unsubscribeOuterContextReceiver: anObject [ 5 | 6 | "This is a hackish way how to unsubscribe a block with a given recevier that is encapsulated in another outer context. 7 | One part of the problem is that subscriptions themeselves can be plain blocks so there is there is no place to register the subscriber. So it cannot be easily unsubscribed and the subscriber needs to be extracted from the block itself" 8 | 9 | subscriptions := subscriptions reject: [ :each | 10 | each size = 1 and: [ 11 | | subscriber | 12 | subscriber := each at: 1. 13 | subscriber isClosure and: [ subscriber receiver = anObject ] ] ]. 14 | ] 15 | -------------------------------------------------------------------------------- /src/Spec-GtkBackendTests/GtkColumnedListAdapterSingleSelectionTest.class.st: -------------------------------------------------------------------------------- 1 | Class { 2 | #name : 'GtkColumnedListAdapterSingleSelectionTest', 3 | #superclass : 'GtkAbstractListAdapterSingleSelectionTest', 4 | #category : 'Spec-GtkBackendTests', 5 | #package : 'Spec-GtkBackendTests' 6 | } 7 | 8 | { #category : 'running' } 9 | GtkColumnedListAdapterSingleSelectionTest >> classToTest [ 10 | ^ SpTablePresenter 11 | ] 12 | 13 | { #category : 'running' } 14 | GtkColumnedListAdapterSingleSelectionTest >> setUp [ 15 | 16 | super setUp. 17 | 18 | window := presenter 19 | beSingleSelection; 20 | addColumn: (SpStringTableColumn evaluated: [:x | x asString ]); 21 | addColumn: (SpStringTableColumn evaluated: [:x | (x + 1) asString ]); 22 | items: #(10 20 30); 23 | openWithSpec. 24 | ] 25 | -------------------------------------------------------------------------------- /src/Spec-Gtk-Code-Diff/SpDiffPresenter.extension.st: -------------------------------------------------------------------------------- 1 | Extension { #name : 'SpDiffPresenter' } 2 | 3 | { #category : '*Spec-Gtk-Code-Diff' } 4 | SpDiffPresenter class >> defaultMarks [ 5 | 6 | ^ { 7 | (SpPatchMark newName: #insert) 8 | backgroundColor: (Color green alpha: 0.1); 9 | iconName: #changeAdd; 10 | yourself. 11 | (SpPatchMark newName: #delete) 12 | backgroundColor: (Color red alpha: 0.1); 13 | iconName: #changeRemove; 14 | yourself. 15 | (SpPatchMark newName: #change) 16 | backgroundColor: (Color gray alpha: 0.1); 17 | iconName: #changeUpdate; 18 | yourself. 19 | } 20 | ] 21 | 22 | { #category : '*Spec-Gtk-Code-Diff' } 23 | SpDiffPresenter >> marks [ 24 | 25 | ^ self class defaultMarks 26 | collect: [ :aMark | aMark name -> aMark ] 27 | as: SmallDictionary 28 | ] 29 | -------------------------------------------------------------------------------- /src/Spec-Gtk-Code/TextEmphasis.extension.st: -------------------------------------------------------------------------------- 1 | Extension { #name : 'TextEmphasis' } 2 | 3 | { #category : '*Spec-Gtk-Code' } 4 | TextEmphasis >> acceptTag: aTag [ 5 | 6 | self attributeSelectors 7 | do: [ :aSelector | aTag perform: aSelector ] 8 | 9 | ] 10 | 11 | { #category : '*Spec-Gtk-Code' } 12 | TextEmphasis class >> attributeSelectors [ 13 | 14 | ^ { 15 | 1 -> #beBold. 16 | 2 -> #beItalic. 17 | 4 -> #beUnderlined. 18 | 8 -> #beNarrow. 19 | 16 -> #beStrikeThrough } 20 | asDictionary 21 | ] 22 | 23 | { #category : '*Spec-Gtk-Code' } 24 | TextEmphasis >> attributeSelectors [ 25 | 26 | ^ Array streamContents: [ :stream | 27 | self class attributeSelectors keysAndValuesDo: [ :code :selector | 28 | (emphasisCode & code) = code ifTrue: [ 29 | stream nextPut: selector ] ] ] 30 | ] 31 | -------------------------------------------------------------------------------- /src/Spec-Gtk/GtkButtonAdapter.class.st: -------------------------------------------------------------------------------- 1 | Class { 2 | #name : 'GtkButtonAdapter', 3 | #superclass : 'GtkBaseButtonAdapter', 4 | #category : 'Spec-Gtk-Adapter', 5 | #package : 'Spec-Gtk', 6 | #tag : 'Adapter' 7 | } 8 | 9 | { #category : 'building' } 10 | GtkButtonAdapter >> addActionTo: gtkButton [ 11 | 12 | gtkButton connectClicked: [ 13 | self runInSystem: [ self presenter performAction ] ] 14 | ] 15 | 16 | { #category : 'building' } 17 | GtkButtonAdapter >> addModelTo: gtkButton [ 18 | 19 | super addModelTo: gtkButton. 20 | self addActionTo: gtkButton 21 | ] 22 | 23 | { #category : 'events' } 24 | GtkButtonAdapter >> clicked [ 25 | 26 | self deprecated: #Gtk4 27 | ] 28 | 29 | { #category : 'building' } 30 | GtkButtonAdapter >> newWidget [ 31 | 32 | ^ self widgetClass newLabel: self getLabelText 33 | ] 34 | -------------------------------------------------------------------------------- /src/Spec-Gtk/GtkButtonBarAdapter.class.st: -------------------------------------------------------------------------------- 1 | Class { 2 | #name : 'GtkButtonBarAdapter', 3 | #superclass : 'GtkAdapter', 4 | #category : 'Spec-Gtk-Adapter', 5 | #package : 'Spec-Gtk', 6 | #tag : 'Adapter' 7 | } 8 | 9 | { #category : 'initialization' } 10 | GtkButtonBarAdapter class >> defaultBorderWidth [ 11 | 12 | ^ 5 13 | ] 14 | 15 | { #category : 'building' } 16 | GtkButtonBarAdapter >> addModelTo: gtkWidget [ 17 | 18 | self model isPlaceAtStart ifTrue: [ gtkWidget placeAtStart ]. 19 | self model isPlaceAtEnd ifTrue: [ gtkWidget placeAtEnd ]. 20 | 21 | gtkWidget margin: self class defaultBorderWidth. 22 | self model items do: [ :each | 23 | gtkWidget packStart: each build ] 24 | ] 25 | 26 | { #category : 'building' } 27 | GtkButtonBarAdapter >> newWidget [ 28 | 29 | ^ GtkButtonBox newHorizontal 30 | ] 31 | -------------------------------------------------------------------------------- /src/Spec-Gtk-Morphic-Adapter/PluggableMenuItemSpec.extension.st: -------------------------------------------------------------------------------- 1 | Extension { #name : 'PluggableMenuItemSpec' } 2 | 3 | { #category : '*Spec-Gtk-Morphic-Adapter' } 4 | PluggableMenuItemSpec >> asMenuItemPresenter [ 5 | "self haltIf: (self separator notNil and: [ self separator ~= false ]). " 6 | | shortcut | 7 | 8 | shortcut := self keyText ifNotNil: [ 9 | self keyText substrings allButFirst 10 | inject: KMMetaModifier new + self keyText substrings first first 11 | into: [ :all :each | all, (each first) ] ]. 12 | 13 | ^ SpMenuItemPresenter new 14 | name: self label; 15 | icon: self icon; 16 | description: self help; 17 | shortcut: shortcut; 18 | action: (self action selector ifNotNil: [ self action ]); 19 | subMenu: (self subMenu ifNotNil: [ self subMenu asMenuPresenter ]); 20 | yourself 21 | ] 22 | -------------------------------------------------------------------------------- /src/Spec-Gtk/GtkSpinnerAdapter.class.st: -------------------------------------------------------------------------------- 1 | Class { 2 | #name : 'GtkSpinnerAdapter', 3 | #superclass : 'GtkAdapter', 4 | #category : 'Spec-Gtk-Adapter', 5 | #package : 'Spec-Gtk', 6 | #tag : 'Adapter' 7 | } 8 | 9 | { #category : 'building' } 10 | GtkSpinnerAdapter >> addModelTo: aSpinner [ 11 | 12 | super addModelTo: aSpinner. 13 | "self updateSpinner: aSpinner withState: self presenter state. 14 | self presenter property: #state whenChangedDo: [ :state | 15 | self updateSpinner: aSpinner withState: state. ]" 16 | ] 17 | 18 | { #category : 'building' } 19 | GtkSpinnerAdapter >> updateSpinner: aSpinner withState: state [ 20 | 21 | state 22 | ifTrue: [ aSpinner start ] 23 | ifFalse: [ aSpinner stop ] 24 | ] 25 | 26 | { #category : 'building' } 27 | GtkSpinnerAdapter >> widgetClass [ 28 | 29 | ^ GtkSpinner 30 | ] 31 | -------------------------------------------------------------------------------- /src/Spec-Gtk-TestLayoutLeaks/SpLayoutLeaksTestFromSelection.class.st: -------------------------------------------------------------------------------- 1 | Class { 2 | #name : #SpLayoutLeaksTestFromSelection, 3 | #superclass : #TestCase, 4 | #category : #'Spec-Gtk-TestLayoutLeaks' 5 | } 6 | 7 | { #category : #tests } 8 | SpLayoutLeaksTestFromSelection >> testOpen [ 9 | | win testPresenter oldAdapters finder | 10 | 11 | self timeLimit: 60 seconds. 12 | 13 | finder := GtkLeakFinder new. 14 | finder start. 15 | win := SpLayoutLeaksTestPresenterFromSelection openGtk. 16 | testPresenter := win presenter. 17 | oldAdapters := testPresenter adapters. 18 | testPresenter swapLayouts. 19 | 30 timesRepeat: [ Smalltalk garbageCollect ]. 20 | self assert: (oldAdapters allSatisfy: [ :e | e isNil ]). 21 | "ReferenceFinder findPathTo: oldAdapters last." 22 | win close. 23 | finder stop. 24 | self assert: finder leaks isEmpty. 25 | ] 26 | -------------------------------------------------------------------------------- /src/Spec-Gtk/GtkAdapterActionDrawingAreaManager.class.st: -------------------------------------------------------------------------------- 1 | Class { 2 | #name : 'GtkAdapterActionDrawingAreaManager', 3 | #superclass : 'GtkAdapterActionManager', 4 | #category : 'Spec-Gtk-Actions', 5 | #package : 'Spec-Gtk', 6 | #tag : 'Actions' 7 | } 8 | 9 | { #category : 'private - actions' } 10 | GtkAdapterActionDrawingAreaManager >> installActionGroupShortcuts: anActionGroup on: gtkWidget [ 11 | 12 | self anyCommandHasShortcut ifFalse: [ ^ self ]. 13 | 14 | gtkWidget focusable: true. 15 | super installActionGroupShortcuts: anActionGroup on: gtkWidget 16 | ] 17 | 18 | { #category : 'private - actions' } 19 | GtkAdapterActionDrawingAreaManager >> installContextMenuOn: gtkWidget [ 20 | 21 | "drawing areas (like the morphic presenter) do not install a controller, 22 | they show the menu calling showContextMenu" 23 | hasContextMenu := true 24 | ] 25 | -------------------------------------------------------------------------------- /src/Spec-Gtk-Keybindings/KMKeyCombination.extension.st: -------------------------------------------------------------------------------- 1 | Extension { #name : #KMKeyCombination } 2 | 3 | { #category : #'*Spec-Gtk-Keybindings' } 4 | KMKeyCombination class >> fromEventKey: evt [ 5 | | modifier control command shift alt | 6 | 7 | control := evt hasControlModifier. 8 | command := evt hasCommandModifier | evt hasMetaModifier | evt hasMod3. 9 | shift := evt hasShiftModifier. 10 | alt := evt hasAltModifier. 11 | 12 | (shift | command | control | alt) 13 | ifFalse: [ ^ evt key asKeyCombination ]. 14 | 15 | modifier := KMNoShortcut new. 16 | control ifTrue: [ modifier := modifier + KMModifier ctrl ]. 17 | command ifTrue: [ modifier := modifier + KMModifier command ]. 18 | shift ifTrue: [ modifier := modifier + KMModifier shift ]. 19 | alt ifTrue: [ modifier := modifier + KMModifier alt ]. 20 | 21 | ^ modifier + evt key asKeyCombination 22 | ] 23 | -------------------------------------------------------------------------------- /src/Spec-Gtk/GtkGtkWidgetAdapter.class.st: -------------------------------------------------------------------------------- 1 | Class { 2 | #name : 'GtkGtkWidgetAdapter', 3 | #superclass : 'GtkAdapter', 4 | #category : 'Spec-Gtk-Adapter', 5 | #package : 'Spec-Gtk', 6 | #tag : 'Adapter' 7 | } 8 | 9 | { #category : 'protocol' } 10 | GtkGtkWidgetAdapter >> doTakeKeyboardFocus: aWidget [ 11 | 12 | self 13 | firstNotContainer: aWidget 14 | ifFound: [ :foundWidget | foundWidget grabFocus ] 15 | 16 | ] 17 | 18 | { #category : 'protocol' } 19 | GtkGtkWidgetAdapter >> firstNotContainer: aWidget ifFound: aBlock [ 20 | 21 | (aWidget isKindOf: GtkContainer) 22 | ifFalse: [ 23 | aBlock value: aWidget. 24 | ^ self ]. 25 | 26 | aWidget children do: [ :each | 27 | self firstNotContainer: each ifFound: aBlock ]. 28 | 29 | ] 30 | 31 | { #category : 'building' } 32 | GtkGtkWidgetAdapter >> newWidget [ 33 | 34 | ^ self presenter widget 35 | ] 36 | -------------------------------------------------------------------------------- /src/Spec-Gtk/GtkAdapterActionCodeManager.class.st: -------------------------------------------------------------------------------- 1 | Class { 2 | #name : 'GtkAdapterActionCodeManager', 3 | #superclass : 'GtkAdapterActionTextManager', 4 | #instVars : [ 5 | 'actions' 6 | ], 7 | #category : 'Spec-Gtk-Actions', 8 | #package : 'Spec-Gtk', 9 | #tag : 'Actions' 10 | } 11 | 12 | { #category : 'private' } 13 | GtkAdapterActionCodeManager >> actions [ 14 | 15 | ^ actions ifNil: [ 16 | actions := SpActionGroup new. 17 | self presenter isOverrideContextMenu ifFalse: [ 18 | actions add: self presenter rootCommandsGroup beDisplayedAsGroup ]. 19 | self presenter actions ifNotNil: [ :aGroup | 20 | actions add: aGroup beDisplayedAsGroup ]. 21 | actions ] 22 | ] 23 | 24 | { #category : 'private - testing' } 25 | GtkAdapterActionCodeManager >> anyCommandIsVisible [ 26 | 27 | ^ self presenter isOverrideContextMenu not 28 | or: [ self presenter actions isNotNil ] 29 | ] 30 | -------------------------------------------------------------------------------- /src/Spec-Gtk/GtkListViewAdapterItemFactory.class.st: -------------------------------------------------------------------------------- 1 | Class { 2 | #name : 'GtkListViewAdapterItemFactory', 3 | #superclass : 'GtkListViewAdapterBaseFactory', 4 | #category : 'Spec-Gtk-Adapter-ListView', 5 | #package : 'Spec-Gtk', 6 | #tag : 'Adapter-ListView' 7 | } 8 | 9 | { #category : 'accessing' } 10 | GtkListViewAdapterItemFactory >> bind: listItem to: anObject [ 11 | | child | 12 | 13 | child := self presenterAtHandle: listItem child. 14 | child ifNil: [ ^ self ]. 15 | 16 | [ 17 | presenter bindAction 18 | value: child 19 | value: anObject ] 20 | on: Error 21 | fork: [ :e | e pass ] 22 | ] 23 | 24 | { #category : 'accessing' } 25 | GtkListViewAdapterItemFactory >> setup: listItem [ 26 | | child | 27 | 28 | child := presenter setupAction cull: presenter. 29 | child build. 30 | 31 | self storePresenter: child. 32 | 33 | listItem child: child adapter widget 34 | ] 35 | -------------------------------------------------------------------------------- /src/Spec-Gtk/GtkAdapterMultiSelection.class.st: -------------------------------------------------------------------------------- 1 | " 2 | adapter to handle multiple selections (maps a presenter selection with a gtk selection) 3 | " 4 | Class { 5 | #name : 'GtkAdapterMultiSelection', 6 | #superclass : 'GtkAdapterSelection', 7 | #instVars : [ 8 | 'oldIndexes' 9 | ], 10 | #category : 'Spec-Gtk-Adapter-ListView', 11 | #package : 'Spec-Gtk', 12 | #tag : 'Adapter-ListView' 13 | } 14 | 15 | { #category : 'instance creation' } 16 | GtkAdapterMultiSelection >> newModel: aModel [ 17 | 18 | ^ GtkMultiSelection newModel: aModel 19 | ] 20 | 21 | { #category : 'private - updating' } 22 | GtkAdapterMultiSelection >> updateSelectionFromGtk [ 23 | 24 | self adapter updateMultiSelectionFromGtk 25 | ] 26 | 27 | { #category : 'updating' } 28 | GtkAdapterMultiSelection >> updateSelectionFromPresenter [ 29 | 30 | oldIndexes := self adapter updateMultiSelectionFromPresenter: oldIndexes 31 | ] 32 | -------------------------------------------------------------------------------- /src/Spec-Gtk/GtkFrameAdapter.class.st: -------------------------------------------------------------------------------- 1 | Class { 2 | #name : 'GtkFrameAdapter', 3 | #superclass : 'GtkAdapter', 4 | #category : 'Spec-Gtk-Adapter', 5 | #package : 'Spec-Gtk', 6 | #tag : 'Adapter' 7 | } 8 | 9 | { #category : 'building' } 10 | GtkFrameAdapter >> addModelTo: gtkFrame [ 11 | 12 | gtkFrame label: self presenter label. 13 | gtkFrame child: self presenterWidget. 14 | 15 | self presenter whenLabelChangedDo: [ 16 | gtkFrame label: self presenter label ]. 17 | self presenter whenPresenterChangedDo: [ 18 | gtkFrame child: self presenterWidget ] 19 | ] 20 | 21 | { #category : 'building' } 22 | GtkFrameAdapter >> presenterWidget [ 23 | 24 | ^ self presenter presenter adapter 25 | ifNotNil: [ :anAdapter | anAdapter widget ] 26 | ifNil: [ self presenter presenter build ] 27 | ] 28 | 29 | { #category : 'building' } 30 | GtkFrameAdapter >> widgetClass [ 31 | 32 | ^ GtkFrame 33 | ] 34 | -------------------------------------------------------------------------------- /src/Spec-GtkBackendTests/GtkAdapterTestCase.class.st: -------------------------------------------------------------------------------- 1 | Class { 2 | #name : 'GtkAdapterTestCase', 3 | #superclass : 'SpBaseTest', 4 | #instVars : [ 5 | 'app' 6 | ], 7 | #category : 'Spec-GtkBackendTests', 8 | #package : 'Spec-GtkBackendTests' 9 | } 10 | 11 | { #category : 'testing' } 12 | GtkAdapterTestCase class >> isAbstract [ 13 | 14 | ^ super isAbstract or: [ self = GtkAdapterTestCase ] 15 | ] 16 | 17 | { #category : 'running' } 18 | GtkAdapterTestCase >> adapter [ 19 | 20 | ^ presenter adapter 21 | ] 22 | 23 | { #category : 'running' } 24 | GtkAdapterTestCase >> initializeTestedInstance [ 25 | super initializeTestedInstance. 26 | 27 | presenter application: app. 28 | ] 29 | 30 | { #category : 'running' } 31 | GtkAdapterTestCase >> runCaseManaged [ 32 | 33 | GtkEngine ensureRunning. 34 | app := SpApplication new. 35 | app useBackend: #Gtk. 36 | 37 | [ super runCaseManaged ] ensure: [ app:= nil ]. 38 | ] 39 | -------------------------------------------------------------------------------- /src/Spec-Gtk/GtkToolbarPopoverButtonAdapter.class.st: -------------------------------------------------------------------------------- 1 | Class { 2 | #name : 'GtkToolbarPopoverButtonAdapter', 3 | #superclass : 'GtkToolbarBaseButtonAdapter', 4 | #instVars : [ 5 | 'menuWidget' 6 | ], 7 | #category : 'Spec-Gtk-Adapter-Toolbar', 8 | #package : 'Spec-Gtk', 9 | #tag : 'Adapter-Toolbar' 10 | } 11 | 12 | { #category : 'building' } 13 | GtkToolbarPopoverButtonAdapter >> addModelTo: gtkToolButton [ 14 | 15 | super addModelTo: gtkToolButton. 16 | gtkToolButton connectClicked: [ self showPopover ] 17 | ] 18 | 19 | { #category : 'building' } 20 | GtkToolbarPopoverButtonAdapter >> newWidget [ 21 | 22 | ^ GtkToolButton 23 | newForm: self presenter icon 24 | label: self presenter label 25 | ] 26 | 27 | { #category : 'building' } 28 | GtkToolbarPopoverButtonAdapter >> showPopover [ 29 | 30 | self presenter newPopover 31 | addStyle: 'popoverButton'; 32 | presenter: self presenter content value; 33 | popup 34 | ] 35 | -------------------------------------------------------------------------------- /src/Spec-Gtk/GtkAdapterSingleSelection.class.st: -------------------------------------------------------------------------------- 1 | " 2 | adapter to handle simple selections (maps a presenter selection with a gtk selection) 3 | " 4 | Class { 5 | #name : 'GtkAdapterSingleSelection', 6 | #superclass : 'GtkAdapterSelection', 7 | #instVars : [ 8 | 'oldIndex' 9 | ], 10 | #category : 'Spec-Gtk-Adapter-ListView', 11 | #package : 'Spec-Gtk', 12 | #tag : 'Adapter-ListView' 13 | } 14 | 15 | { #category : 'instance creation' } 16 | GtkAdapterSingleSelection >> newModel: aModel [ 17 | 18 | ^ GtkSingleSelection new 19 | autoSelect: false; 20 | model: aModel; 21 | yourself 22 | ] 23 | 24 | { #category : 'private - updating' } 25 | GtkAdapterSingleSelection >> updateSelectionFromGtk [ 26 | 27 | self adapter updateSingleSelectionFromGtk 28 | ] 29 | 30 | { #category : 'updating' } 31 | GtkAdapterSingleSelection >> updateSelectionFromPresenter [ 32 | 33 | oldIndex := self adapter updateSingleSelectionFromPresenter: oldIndex 34 | ] 35 | -------------------------------------------------------------------------------- /src/Spec-Gtk/GtkTHaveWrappingScrollBars.trait.st: -------------------------------------------------------------------------------- 1 | Trait { 2 | #name : 'GtkTHaveWrappingScrollBars', 3 | #instVars : [ 4 | 'innerWidget' 5 | ], 6 | #category : 'Spec-Gtk-Adapter-List', 7 | #package : 'Spec-Gtk', 8 | #tag : 'Adapter-List' 9 | } 10 | 11 | { #category : 'private - accessing' } 12 | GtkTHaveWrappingScrollBars >> innerWidget [ 13 | 14 | ^ innerWidget 15 | ] 16 | 17 | { #category : 'building' } 18 | GtkTHaveWrappingScrollBars >> wrapWidget: gtkWidget [ 19 | | wrapWidget | 20 | 21 | innerWidget := gtkWidget. 22 | self model hasScrollBars ifFalse: [ ^ super wrapWidget: gtkWidget ]. 23 | wrapWidget := self wrapWithScrollableWindow: innerWidget. 24 | 25 | wrapWidget 26 | propagateNaturalWidth: self presenter isPropagateNaturalWidth; 27 | propagateNaturalHeight: self presenter isPropagateNaturalHeight. 28 | 29 | self presenter scrollBarStyles ifNotNil: [ :styles | 30 | styles do: [ :each | wrapWidget addClass: each ] ]. 31 | 32 | ^ wrapWidget 33 | ] 34 | -------------------------------------------------------------------------------- /src/Spec-Gtk/GtkDropListAdapterItemFactory.class.st: -------------------------------------------------------------------------------- 1 | " 2 | Item factory to be used on `GtkDropListAdapter`. 3 | It serves `SpDropListItemPresenter` instances. 4 | " 5 | Class { 6 | #name : 'GtkDropListAdapterItemFactory', 7 | #superclass : 'GtkListViewAdapterBaseFactory', 8 | #category : 'Spec-Gtk-Adapter-List', 9 | #package : 'Spec-Gtk', 10 | #tag : 'Adapter-List' 11 | } 12 | 13 | { #category : 'accessing' } 14 | GtkDropListAdapterItemFactory >> bind: listItem to: anObject [ 15 | | child | 16 | 17 | child := self presenterAtHandle: listItem child. 18 | child model: anObject 19 | ] 20 | 21 | { #category : 'private' } 22 | GtkDropListAdapterItemFactory >> getItems [ 23 | 24 | ^ self presenter getList 25 | ] 26 | 27 | { #category : 'accessing' } 28 | GtkDropListAdapterItemFactory >> setup: listItem [ 29 | | child | 30 | 31 | child := presenter instantiate: SpDropListItemPresenter. 32 | child build. 33 | 34 | self storePresenter: child. 35 | 36 | listItem child: child adapter widget 37 | ] 38 | -------------------------------------------------------------------------------- /src/Spec-Gtk/GtkProgressBarAdapter.class.st: -------------------------------------------------------------------------------- 1 | Class { 2 | #name : 'GtkProgressBarAdapter', 3 | #superclass : 'GtkAdapter', 4 | #category : 'Spec-Gtk-Adapter', 5 | #package : 'Spec-Gtk', 6 | #tag : 'Adapter' 7 | } 8 | 9 | { #category : 'building' } 10 | GtkProgressBarAdapter >> addModelTo: gtkWidget [ 11 | 12 | gtkWidget showText. 13 | self updateState 14 | ] 15 | 16 | { #category : 'api' } 17 | GtkProgressBarAdapter >> fixedValue: aNumber [ 18 | 19 | self innerWidgetDo: [ :w | 20 | w progress: aNumber asFloat ] 21 | ] 22 | 23 | { #category : 'api' } 24 | GtkProgressBarAdapter >> indeterminateValue [ 25 | 26 | self innerWidgetDo: [ :w | 27 | w pulse ] 28 | ] 29 | 30 | { #category : 'api' } 31 | GtkProgressBarAdapter >> updateState [ 32 | 33 | self presenter state ifNil: [ ^ self ]. 34 | 35 | self presenter state applyTo: self. 36 | self flag: #TODO. "This may be a problem now?" 37 | "GRunLoop current isInCallback 38 | ifTrue: [ Gtk3PollingRunLoop new processEvents ]" 39 | ] 40 | 41 | { #category : 'building' } 42 | GtkProgressBarAdapter >> widgetClass [ 43 | 44 | ^ GtkProgressBar 45 | ] 46 | -------------------------------------------------------------------------------- /src/Spec-Gtk-Code-Diff/GtkPatchSideBySideVisitorTest.class.st: -------------------------------------------------------------------------------- 1 | Class { 2 | #name : 'GtkPatchSideBySideVisitorTest', 3 | #superclass : 'TestCase', 4 | #category : 'Spec-Gtk-Code-Diff', 5 | #package : 'Spec-Gtk-Code-Diff' 6 | } 7 | 8 | { #category : 'tests' } 9 | GtkPatchSideBySideVisitorTest >> testPatchIncludesLastLine [ 10 | | patch visitor fileA fileB | 11 | 12 | fileA := 'newSourceView 13 | 14 | ^ GtkSourceView new 15 | beWrapWord; 16 | showLineNumbers: true; 17 | autoIndent: true; 18 | yourself'. 19 | 20 | fileB := 'newSourceView 21 | 22 | ^ GtkSourceView new 23 | beWrapWord; 24 | monospace: true; 25 | showLineNumbers: "self presenter hasLineNumbers" false; 26 | showLineMarks: true; 27 | autoIndent: true; 28 | indentOnTab: true; 29 | tabWidth: 4; 30 | yourself'. 31 | 32 | patch := DiffBuilder 33 | buildPatchFrom: fileA lines 34 | to: fileB lines. 35 | 36 | visitor := GtkPatchSideBySideVisitor new. 37 | patch accept: visitor. 38 | 39 | self assert: visitor leftText lines last trimmed equals: 'yourself'. 40 | self assert: visitor rightText lines last trimmed equals: 'yourself'. 41 | 42 | ] 43 | -------------------------------------------------------------------------------- /src/Spec-Gtk/GtkColumnedListAdapter.class.st: -------------------------------------------------------------------------------- 1 | Class { 2 | #name : 'GtkColumnedListAdapter', 3 | #superclass : 'GtkBaseListAdapter', 4 | #traits : 'GtkTTableAccessing', 5 | #classTraits : 'GtkTTableAccessing classTrait', 6 | #category : 'Spec-Gtk-Adapter-List', 7 | #package : 'Spec-Gtk', 8 | #tag : 'Adapter-List' 9 | } 10 | 11 | { #category : 'building' } 12 | GtkColumnedListAdapter >> addModelTo: gtkList [ 13 | 14 | super addModelTo: gtkList. 15 | 16 | gtkList 17 | headersVisible: self model isShowingColumnHeaders; 18 | beSingleSelectionMode. 19 | self addColumnsTo: gtkList. 20 | gtkList model: self newTreeStore. 21 | self addSortableColumnsTo: gtkList. 22 | 23 | gtkList selection unselectAll. 24 | self presenter selection isEmpty ifFalse: [ 25 | gtkList selection selectPath: self presenter selection selectedIndexes ]. 26 | 27 | gtkList connectSelectionChanged: [ 28 | self presenter selection selectIndexes: gtkList allSelected flattened ] 29 | ] 30 | 31 | { #category : 'events' } 32 | GtkColumnedListAdapter >> doRefreshList: gtkWidget [ 33 | 34 | super doRefreshList: gtkWidget. 35 | self addSortableColumnsTo: gtkWidget 36 | ] 37 | -------------------------------------------------------------------------------- /src/Spec-Gtk/GtkSwitchAdapter.class.st: -------------------------------------------------------------------------------- 1 | Class { 2 | #name : 'GtkSwitchAdapter', 3 | #superclass : 'GtkAdapter', 4 | #category : 'Spec-Gtk-Adapter', 5 | #package : 'Spec-Gtk', 6 | #tag : 'Adapter' 7 | } 8 | 9 | { #category : 'building' } 10 | GtkSwitchAdapter >> addModelTo: gtkWidget [ 11 | 12 | super addModelTo: gtkWidget. 13 | 14 | gtkWidget active: self presenter state. 15 | 16 | gtkWidget connectStateSet: [ 17 | self backendUpdatingDo: [ self updatePresenterState ]. 18 | false ]. 19 | self presenter whenChangedDo: [ 20 | self withCycleDetectionOnBackendDo: [ self updateState ] ] 21 | ] 22 | 23 | { #category : 'accessing' } 24 | GtkSwitchAdapter >> state [ 25 | 26 | ^ widget isActive 27 | ] 28 | 29 | { #category : 'updating' } 30 | GtkSwitchAdapter >> updatePresenterState [ 31 | 32 | self presenter state: self state 33 | ] 34 | 35 | { #category : 'updating' } 36 | GtkSwitchAdapter >> updateState [ 37 | 38 | self widgetDo: [ :w | 39 | self presenter state = w isActive 40 | ifFalse: [ w active: self presenter state ] ] 41 | ] 42 | 43 | { #category : 'factory' } 44 | GtkSwitchAdapter >> widgetClass [ 45 | 46 | ^ GtkSwitch 47 | ] 48 | -------------------------------------------------------------------------------- /src/Spec-Gtk/GtkActionBarAdapter.class.st: -------------------------------------------------------------------------------- 1 | Class { 2 | #name : 'GtkActionBarAdapter', 3 | #superclass : 'GtkAdapter', 4 | #category : 'Spec-Gtk-Adapter', 5 | #package : 'Spec-Gtk', 6 | #tag : 'Adapter' 7 | } 8 | 9 | { #category : 'building' } 10 | GtkActionBarAdapter >> addModelTo: gtkWidget [ 11 | 12 | (self itemsAt: #start) 13 | do: [ :each | gtkWidget packStart: each build ]. 14 | (self itemsAt: #end) 15 | reverseDo: [ :each | gtkWidget packEnd: each build ]. 16 | 17 | self presenter centerPresenter 18 | ifNotNil: [ :aPresenter | gtkWidget centerWidget: aPresenter build ]. 19 | 20 | self presenter whenCenterPresenterChangedDo: [ :aPresenter | 21 | self updateCenterPresenter ] 22 | ] 23 | 24 | { #category : 'private' } 25 | GtkActionBarAdapter >> itemsAt: placeSymbol [ 26 | 27 | ^ self model items 28 | at: placeSymbol 29 | ifAbsent: [ #() ] 30 | 31 | ] 32 | 33 | { #category : 'private - updating' } 34 | GtkActionBarAdapter >> updateCenterPresenter [ 35 | 36 | self widgetDo: [ :w | 37 | w centerWidget: self presenter centerPresenter build ] 38 | ] 39 | 40 | { #category : 'building' } 41 | GtkActionBarAdapter >> widgetClass [ 42 | 43 | ^ GtkActionBar 44 | ] 45 | -------------------------------------------------------------------------------- /src/Spec-Gtk/GtkOverlayAdapter.class.st: -------------------------------------------------------------------------------- 1 | Class { 2 | #name : 'GtkOverlayAdapter', 3 | #superclass : 'GtkLayoutAdapter', 4 | #category : 'Spec-Gtk-Layout-Box', 5 | #package : 'Spec-Gtk', 6 | #tag : 'Layout-Box' 7 | } 8 | 9 | { #category : 'private' } 10 | GtkOverlayAdapter >> applyLayout: aLayout [ 11 | 12 | widget := GtkOverlay new. 13 | self connectToEvents: aLayout 14 | ] 15 | 16 | { #category : 'private' } 17 | GtkOverlayAdapter >> basicAdd: aPresenter constraints: constraints to: aWidget [ 18 | | childWidget | 19 | 20 | childWidget := aPresenter buildWithSelector: constraints spec. 21 | constraints isOverlay 22 | ifFalse: [ 23 | aWidget child: childWidget ] 24 | ifTrue: [ 25 | childWidget 26 | hAlignCenter; 27 | vAlignCenter. 28 | aWidget addOverlay: childWidget ]. 29 | 30 | self basicApplyAlignmentTo: childWidget constraints: constraints. 31 | 32 | ^ aWidget 33 | ] 34 | 35 | { #category : 'accessing' } 36 | GtkOverlayAdapter >> basicApplyAlignmentTo: childWidget constraints: constraints [ 37 | 38 | constraints hAlign ifNotNil: [ :hAlign | childWidget hAlign: hAlign asGtkAlign ]. 39 | constraints vAlign ifNotNil: [ :vAlign | childWidget vAlign: vAlign asGtkAlign ] 40 | ] 41 | -------------------------------------------------------------------------------- /src/Spec-Gtk/GMenuCompound.class.st: -------------------------------------------------------------------------------- 1 | Class { 2 | #name : 'GMenuCompound', 3 | #superclass : 'Object', 4 | #instVars : [ 5 | 'menu', 6 | 'actionGroup', 7 | 'menuItemActions' 8 | ], 9 | #category : 'Spec-Gtk-Adapter-Menu', 10 | #package : 'Spec-Gtk', 11 | #tag : 'Adapter-Menu' 12 | } 13 | 14 | { #category : 'instance creation' } 15 | GMenuCompound class >> newMenu: aMenu [ 16 | 17 | ^ self new 18 | menu: aMenu; 19 | yourself 20 | ] 21 | 22 | { #category : 'accessing' } 23 | GMenuCompound >> actionGroup [ 24 | 25 | ^ actionGroup 26 | ] 27 | 28 | { #category : 'accessing' } 29 | GMenuCompound >> addMenuItemAction: aMenuItemAction [ 30 | 31 | actionGroup insert: aMenuItemAction action. 32 | menuItemActions add: aMenuItemAction 33 | ] 34 | 35 | { #category : 'initialization' } 36 | GMenuCompound >> initialize [ 37 | 38 | super initialize. 39 | menuItemActions := Set new 40 | ] 41 | 42 | { #category : 'accessing' } 43 | GMenuCompound >> menu [ 44 | 45 | ^ menu 46 | ] 47 | 48 | { #category : 'initialization' } 49 | GMenuCompound >> menu: anObject [ 50 | 51 | menu := anObject 52 | ] 53 | 54 | { #category : 'accessing' } 55 | GMenuCompound >> menuItemActions [ 56 | 57 | ^ menuItemActions 58 | ] 59 | -------------------------------------------------------------------------------- /src/Spec-Gtk/SpLabelPresenter.extension.st: -------------------------------------------------------------------------------- 1 | Extension { #name : 'SpLabelPresenter' } 2 | 3 | { #category : '*Spec-Gtk' } 4 | SpLabelPresenter >> beJustifyCenter [ 5 | 6 | self withAdapterPerformOrDefer: [ :anAdapter | anAdapter beJustifyCenter ] 7 | ] 8 | 9 | { #category : '*Spec-Gtk' } 10 | SpLabelPresenter >> beJustifyLeft [ 11 | 12 | self withAdapterPerformOrDefer: [ :anAdapter | anAdapter beJustifyLeft ] 13 | ] 14 | 15 | { #category : '*Spec-Gtk' } 16 | SpLabelPresenter >> beJustifyRight [ 17 | 18 | self withAdapterPerformOrDefer: [ :anAdapter | anAdapter beJustifyRight ] 19 | ] 20 | 21 | { #category : '*Spec-Gtk' } 22 | SpLabelPresenter >> beNotWrap [ 23 | 24 | self withAdapterPerformOrDefer: [ :anAdapter | anAdapter beNotWrap ] 25 | ] 26 | 27 | { #category : '*Spec-Gtk' } 28 | SpLabelPresenter >> beWrap [ 29 | 30 | self withAdapterPerformOrDefer: [ :anAdapter | anAdapter beWrap ] 31 | ] 32 | 33 | { #category : '*Spec-Gtk' } 34 | SpLabelPresenter >> isWrap [ 35 | 36 | self withAdapterDo: [ :anAdapter | ^ anAdapter isWrap ]. 37 | 38 | ^ false 39 | ] 40 | 41 | { #category : '*Spec-Gtk' } 42 | SpLabelPresenter >> useMarkup [ 43 | 44 | self withAdapterPerformOrDefer: [ :anAdapter | anAdapter useMarkup ] 45 | ] 46 | -------------------------------------------------------------------------------- /src/Spec-Gtk/GtkImageAdapter.class.st: -------------------------------------------------------------------------------- 1 | Class { 2 | #name : 'GtkImageAdapter', 3 | #superclass : 'GtkAdapter', 4 | #category : 'Spec-Gtk-Adapter', 5 | #package : 'Spec-Gtk', 6 | #tag : 'Adapter' 7 | } 8 | 9 | { #category : 'accessing' } 10 | GtkImageAdapter >> addModelTo: gtkImage [ 11 | 12 | super addModelTo: gtkImage. 13 | 14 | self updateForm: self model image into: gtkImage. 15 | self model whenImageChangeDo: [ 16 | self widgetDo: [ :w | 17 | self updateForm: self model image into: gtkImage ] ] 18 | ] 19 | 20 | { #category : 'accessing' } 21 | GtkImageAdapter >> image [ 22 | 23 | ^ self widget 24 | ] 25 | 26 | { #category : 'building' } 27 | GtkImageAdapter >> newWidget [ 28 | 29 | ^ GtkImage newEmpty 30 | ] 31 | 32 | { #category : 'updating' } 33 | GtkImageAdapter >> updateForm: aFormOrGdkPixbuf into: aGtkImage [ 34 | | paintable | 35 | 36 | aFormOrGdkPixbuf ifNil: [ 37 | aGtkImage clear. 38 | ^ self ]. 39 | 40 | paintable := aFormOrGdkPixbuf asGdkPaintable. 41 | aFormOrGdkPixbuf isForm ifTrue: [ 42 | | size | 43 | size := aFormOrGdkPixbuf width@aFormOrGdkPixbuf height. 44 | paintable 45 | computeConcreteSize: size 46 | defaults: size ]. 47 | aGtkImage setFromPaintable: paintable 48 | ] 49 | -------------------------------------------------------------------------------- /src/Spec-Gtk/GtkAdapterSelection.class.st: -------------------------------------------------------------------------------- 1 | " 2 | A base selection adapter. 3 | " 4 | Class { 5 | #name : 'GtkAdapterSelection', 6 | #superclass : 'Object', 7 | #instVars : [ 8 | 'adapter' 9 | ], 10 | #category : 'Spec-Gtk-Adapter-ListView', 11 | #package : 'Spec-Gtk', 12 | #tag : 'Adapter-ListView' 13 | } 14 | 15 | { #category : 'instance creation' } 16 | GtkAdapterSelection class >> on: anAdapter [ 17 | 18 | ^ self new 19 | adapter: anAdapter; 20 | yourself 21 | ] 22 | 23 | { #category : 'accessing' } 24 | GtkAdapterSelection >> adapter [ 25 | 26 | ^ adapter 27 | ] 28 | 29 | { #category : 'accessing' } 30 | GtkAdapterSelection >> adapter: anAdapter [ 31 | 32 | adapter := anAdapter 33 | ] 34 | 35 | { #category : 'instance creation' } 36 | GtkAdapterSelection >> newModel: aModel [ 37 | 38 | self subclassResponsibility 39 | ] 40 | 41 | { #category : 'accessing' } 42 | GtkAdapterSelection >> presenter [ 43 | 44 | ^ self adapter presenter 45 | ] 46 | 47 | { #category : 'private - updating' } 48 | GtkAdapterSelection >> updateSelectionFromGtk [ 49 | 50 | self subclassResponsibility 51 | ] 52 | 53 | { #category : 'updating' } 54 | GtkAdapterSelection >> updateSelectionFromPresenter [ 55 | 56 | self subclassResponsibility 57 | ] 58 | -------------------------------------------------------------------------------- /src/Spec-Gtk-Morphic-Adapter/GtkMorphAdapter.class.st: -------------------------------------------------------------------------------- 1 | Class { 2 | #name : 'GtkMorphAdapter', 3 | #superclass : 'GtkAdapter', 4 | #category : 'Spec-Gtk-Morphic-Adapter', 5 | #package : 'Spec-Gtk-Morphic-Adapter' 6 | } 7 | 8 | { #category : 'building' } 9 | GtkMorphAdapter >> addModelTo: gtkWidget [ 10 | 11 | self presenter whenMorphChangedDo: [ :aMorph | 12 | self widgetDo: [ :w | self setMorph: aMorph to: w ] ]. 13 | self setMorph: self presenter morph to: gtkWidget. 14 | self model contextMenu 15 | ifNotNil: [ :menu | self addMenu: menu to: gtkWidget ] 16 | 17 | ] 18 | 19 | { #category : 'private - actions' } 20 | GtkMorphAdapter >> newActionManager [ 21 | 22 | ^ GtkAdapterActionDrawingAreaManager on: self 23 | ] 24 | 25 | { #category : 'building' } 26 | GtkMorphAdapter >> setMorph: aMorph to: gtkWidget [ 27 | 28 | aMorph ifNil: [ ^ self ]. 29 | 30 | aMorph presenter: self presenter. 31 | gtkWidget morph: aMorph. 32 | "if morph is rigid, then widget is not resizable" 33 | ((aMorph vResizing = #rigid) 34 | and: [ aMorph hResizing = #rigid ]) 35 | ifTrue: [ gtkWidget beMorphNotResizable ] 36 | ifFalse: [ gtkWidget beMorphResizable ] 37 | ] 38 | 39 | { #category : 'building' } 40 | GtkMorphAdapter >> widgetClass [ 41 | 42 | ^ GtkMorphView 43 | ] 44 | -------------------------------------------------------------------------------- /src/Spec-Gtk/GtkListViewAdapterDataStore.class.st: -------------------------------------------------------------------------------- 1 | " 2 | A data store to be used in `GtkListViewAdapter` 3 | " 4 | Class { 5 | #name : 'GtkListViewAdapterDataStore', 6 | #superclass : 'GListReferenceStore', 7 | #instVars : [ 8 | 'presenter' 9 | ], 10 | #category : 'Spec-Gtk-Adapter-ListView', 11 | #package : 'Spec-Gtk', 12 | #tag : 'Adapter-ListView' 13 | } 14 | 15 | { #category : 'instance creation' } 16 | GtkListViewAdapterDataStore class >> newPresenter: aPresenter [ 17 | 18 | ^ self new 19 | presenter: aPresenter; 20 | yourself 21 | ] 22 | 23 | { #category : 'accessing' } 24 | GtkListViewAdapterDataStore >> items [ 25 | 26 | self flag: #TODO. "This may be bad? no idea, but it prevents crashes :P" 27 | ^ items ifNil: [ 28 | items := presenter items 29 | ifNotNil: [ :aCollection | aCollection copy ] 30 | ifNil: [ #() ] ] 31 | ] 32 | 33 | { #category : 'accessing' } 34 | GtkListViewAdapterDataStore >> items: aCollection [ 35 | 36 | self reset 37 | ] 38 | 39 | { #category : 'accessing' } 40 | GtkListViewAdapterDataStore >> presenter: aPresenter [ 41 | 42 | presenter := aPresenter. 43 | self reset 44 | ] 45 | 46 | { #category : 'as yet unclassified' } 47 | GtkListViewAdapterDataStore >> reset [ 48 | 49 | super reset. 50 | items := nil 51 | ] 52 | -------------------------------------------------------------------------------- /src/Spec-Gtk-Code-Diff/GtkDiffAdapter.class.st: -------------------------------------------------------------------------------- 1 | Class { 2 | #name : 'GtkDiffAdapter', 3 | #superclass : 'GtkPatchSideBySideAdapter', 4 | #instVars : [ 5 | 'leftText', 6 | 'rightText' 7 | ], 8 | #category : 'Spec-Gtk-Code-Diff', 9 | #package : 'Spec-Gtk-Code-Diff' 10 | } 11 | 12 | { #category : 'adding' } 13 | GtkDiffAdapter >> addPatchTo: aView [ 14 | 15 | leftText := self presenter leftText. 16 | rightText := self presenter rightText. 17 | self setPatch 18 | ] 19 | 20 | { #category : 'accessing' } 21 | GtkDiffAdapter >> leftLabel: aString [ 22 | "not supported" 23 | ] 24 | 25 | { #category : 'accessing' } 26 | GtkDiffAdapter >> leftText: aString [ 27 | 28 | leftText := aString. 29 | self innerWidgetDo: [ :w | self setPatch ] 30 | ] 31 | 32 | { #category : 'accessing' } 33 | GtkDiffAdapter >> rightLabel: aString [ 34 | "not supported" 35 | ] 36 | 37 | { #category : 'accessing' } 38 | GtkDiffAdapter >> rightText: aString [ 39 | 40 | rightText := aString. 41 | self innerWidgetDo: [ :w | self setPatch ] 42 | ] 43 | 44 | { #category : 'initialization' } 45 | GtkDiffAdapter >> setPatch [ 46 | | patch | 47 | 48 | patch := DiffBuilder 49 | buildPatchFrom: (leftText ifNil: [ '' ]) lines 50 | to: (rightText ifNil: [ '' ]) lines. 51 | 52 | self setPatch: patch 53 | ] 54 | -------------------------------------------------------------------------------- /src/Spec-Gtk/GtkAdapterActionTextInputFieldManager.class.st: -------------------------------------------------------------------------------- 1 | Class { 2 | #name : 'GtkAdapterActionTextInputFieldManager', 3 | #superclass : 'GtkAdapterActionTextManager', 4 | #instVars : [ 5 | 'actions' 6 | ], 7 | #category : 'Spec-Gtk-Actions', 8 | #package : 'Spec-Gtk', 9 | #tag : 'Actions' 10 | } 11 | 12 | { #category : 'private - actions' } 13 | GtkAdapterActionTextInputFieldManager >> installActionGroupShortcuts: anActionGroup on: gtkWidget [ 14 | 15 | super installActionGroupShortcuts: anActionGroup on: gtkWidget. 16 | self maybeInstallCROn: gtkWidget 17 | ] 18 | 19 | { #category : 'private - actions' } 20 | GtkAdapterActionTextInputFieldManager >> maybeInstallCROn: gtkEntry [ 21 | | enter | 22 | 23 | "GtkEntry implements the activation signal, which means if we have a CR shortcut 24 | defined (Pharo can do this time to time), it will not work, because it will send 25 | the signal instead. To fix this (since spec does not implement activation signal 26 | for input fields), I detect if I have defined it and if that's the case, I install 27 | the shortcut as a signal" 28 | enter := KeyboardKey enter asKeyCombination. 29 | actionMap keysDo: [ :each | 30 | (each hasShortcutKey and: [ each shortcutKey = enter ]) 31 | ifTrue: [ 32 | gtkEntry connectActivate: [ 33 | self runInSystem: [ each execute ] ] ] ] 34 | ] 35 | -------------------------------------------------------------------------------- /src/Spec-Gtk/GtkScrollableAdapter.class.st: -------------------------------------------------------------------------------- 1 | Class { 2 | #name : 'GtkScrollableAdapter', 3 | #superclass : 'GtkLayoutAdapter', 4 | #category : 'Spec-Gtk-Layout-Box', 5 | #package : 'Spec-Gtk', 6 | #tag : 'Layout-Box' 7 | } 8 | 9 | { #category : 'private' } 10 | GtkScrollableAdapter >> addConstraints: constraints toChild: childWidget [ 11 | "adds constraits by child." 12 | 13 | ^ childWidget 14 | ] 15 | 16 | { #category : 'accessing' } 17 | GtkScrollableAdapter >> addWidgetAlignment: constraints to: gtkWidget [ 18 | 19 | layout vAlign 20 | ifNotNil: [ :align | gtkWidget vAlign: align asGtkAlign ]. 21 | layout hAlign 22 | ifNotNil: [ :align | gtkWidget hAlign: align asGtkAlign ] 23 | ] 24 | 25 | { #category : 'private' } 26 | GtkScrollableAdapter >> applyLayout: aLayout [ 27 | 28 | widget := GtkScrolledWindow new. 29 | self connectToEvents: aLayout 30 | ] 31 | 32 | { #category : 'private' } 33 | GtkScrollableAdapter >> basicAdd: aPresenter constraints: constraints to: gtkWidget [ 34 | | childWidget | 35 | 36 | childWidget := aPresenter buildWithSelector: constraints spec. 37 | gtkWidget child: childWidget. 38 | 39 | ^ gtkWidget 40 | ] 41 | 42 | { #category : 'scrolling' } 43 | GtkScrollableAdapter >> scrollTo: aPoint [ 44 | 45 | self widgetDo: [ :w | 46 | w hAdjustment value: aPoint x. 47 | w vAdjustment value: aPoint y ] 48 | ] 49 | -------------------------------------------------------------------------------- /src/Spec-Gtk/GtkColumnViewAdapterItemFactory.class.st: -------------------------------------------------------------------------------- 1 | Class { 2 | #name : 'GtkColumnViewAdapterItemFactory', 3 | #superclass : 'GtkListViewAdapterBaseFactory', 4 | #instVars : [ 5 | 'column' 6 | ], 7 | #category : 'Spec-Gtk-Adapter-ListView', 8 | #package : 'Spec-Gtk', 9 | #tag : 'Adapter-ListView' 10 | } 11 | 12 | { #category : 'instance creation' } 13 | GtkColumnViewAdapterItemFactory class >> newPresenter: aPresenter column: aColumn [ 14 | 15 | ^ self new 16 | presenter: aPresenter; 17 | column: aColumn; 18 | yourself 19 | ] 20 | 21 | { #category : 'accessing' } 22 | GtkColumnViewAdapterItemFactory >> bind: listItem to: anObject [ 23 | | child | 24 | 25 | child := self presenterAtHandle: listItem child. 26 | child ifNil: [ ^ self ]. 27 | 28 | self column bindAction 29 | value: child 30 | value: anObject 31 | ] 32 | 33 | { #category : 'accessing' } 34 | GtkColumnViewAdapterItemFactory >> column [ 35 | 36 | ^ column 37 | ] 38 | 39 | { #category : 'accessing' } 40 | GtkColumnViewAdapterItemFactory >> column: aColumn [ 41 | 42 | column := aColumn 43 | ] 44 | 45 | { #category : 'accessing' } 46 | GtkColumnViewAdapterItemFactory >> setup: listItem [ 47 | | child | 48 | 49 | child := self column setupAction cull: presenter. 50 | child build. 51 | 52 | self storePresenter: child. 53 | 54 | listItem child: child adapter widget 55 | ] 56 | -------------------------------------------------------------------------------- /src/Spec-Gtk/GtkActionShortcutInstaller.class.st: -------------------------------------------------------------------------------- 1 | " 2 | installs the shortcuts defined in the actions into a widget. 3 | " 4 | Class { 5 | #name : 'GtkActionShortcutInstaller', 6 | #superclass : 'GtkActionVisitor', 7 | #instVars : [ 8 | 'filters' 9 | ], 10 | #category : 'Spec-Gtk-Actions', 11 | #package : 'Spec-Gtk', 12 | #tag : 'Actions' 13 | } 14 | 15 | { #category : 'accessing' } 16 | GtkActionShortcutInstaller >> filters: aCollection [ 17 | 18 | filters := aCollection 19 | ] 20 | 21 | { #category : 'initialization' } 22 | GtkActionShortcutInstaller >> initialize [ 23 | 24 | super initialize. 25 | filters := #() 26 | ] 27 | 28 | { #category : 'private - testing' } 29 | GtkActionShortcutInstaller >> isFiltered: aCommand [ 30 | 31 | ^ filters includes: aCommand name 32 | ] 33 | 34 | { #category : 'visiting' } 35 | GtkActionShortcutInstaller >> visitCommand: aCommand [ 36 | | shortcut | 37 | 38 | aCommand hasShortcutKey ifFalse: [ ^ self ]. 39 | (self isFiltered: aCommand) ifTrue: [ ^ self ]. 40 | 41 | "I need to install an action for each key combination" 42 | aCommand shortcutKey withAllKeyCombinationsDo: [ :aKeyCombination | 43 | aKeyCombination isForPlatform ifTrue: [ 44 | shortcut := GtkShortcut 45 | newKeyCombination: aKeyCombination 46 | actionName: (self actionNameFor: aCommand). 47 | self widget addShortcut: shortcut ] ] 48 | ] 49 | -------------------------------------------------------------------------------- /src/Spec-Gtk/GtkTreeColumnViewExpanderAdapterItemFactory.class.st: -------------------------------------------------------------------------------- 1 | Class { 2 | #name : 'GtkTreeColumnViewExpanderAdapterItemFactory', 3 | #superclass : 'GtkTreeColumnViewAdapterItemFactory', 4 | #category : 'Spec-Gtk-Adapter-ListView', 5 | #package : 'Spec-Gtk', 6 | #tag : 'Adapter-ListView' 7 | } 8 | 9 | { #category : 'accessing' } 10 | GtkTreeColumnViewExpanderAdapterItemFactory >> bind: listItem [ 11 | | child expander row itemReference itemStore item | 12 | 13 | expander := self objectAtHandle: listItem child. 14 | 15 | row := GtkTreeListRow fromHandleUnreferenced: listItem item getHandle. 16 | expander listRow: row. 17 | child := self presenterAtHandle: expander child getHandle. 18 | child ifNil: [ ^ self ]. 19 | 20 | itemReference := row item. 21 | itemStore := store storeAt: (itemReference dataAt: 'store'). 22 | item := itemStore itemAtHandle: itemReference getHandle. 23 | itemReference objectUnref. 24 | 25 | self column bindAction 26 | value: child 27 | value: item 28 | ] 29 | 30 | { #category : 'accessing' } 31 | GtkTreeColumnViewExpanderAdapterItemFactory >> setup: listItem [ 32 | | child expander | 33 | 34 | child := self column setupAction cull: presenter. 35 | child build. 36 | 37 | self storePresenter: child. 38 | expander := GtkTreeExpander newWidget: child adapter widget. 39 | self storeObject: expander. 40 | 41 | listItem child: expander 42 | ] 43 | -------------------------------------------------------------------------------- /src/Spec-Gtk-Code/GtkTextStyleTag.class.st: -------------------------------------------------------------------------------- 1 | Class { 2 | #name : 'GtkTextStyleTag', 3 | #superclass : 'Object', 4 | #instVars : [ 5 | 'name', 6 | 'start', 7 | 'stop' 8 | ], 9 | #category : 'Spec-Gtk-Code-Base', 10 | #package : 'Spec-Gtk-Code', 11 | #tag : 'Base' 12 | } 13 | 14 | { #category : 'instance creation' } 15 | GtkTextStyleTag class >> newName: aString from: start to: stop [ 16 | 17 | ^ self basicNew 18 | initializeName: aString from: start to: stop; 19 | yourself 20 | ] 21 | 22 | { #category : 'visiting' } 23 | GtkTextStyleTag >> acceptTextBuffer: textBuffer [ 24 | 25 | textBuffer 26 | applyTagByName: self name asString 27 | start: self start - 1 28 | end: self stop 29 | ] 30 | 31 | { #category : 'initialization' } 32 | GtkTextStyleTag >> initializeName: aString from: startNumber to: stopNumber [ 33 | 34 | self initialize. 35 | name := aString. 36 | start := startNumber. 37 | stop := stopNumber 38 | ] 39 | 40 | { #category : 'accessing' } 41 | GtkTextStyleTag >> name [ 42 | 43 | ^ name 44 | ] 45 | 46 | { #category : 'printing' } 47 | GtkTextStyleTag >> printOn: aStream [ 48 | 49 | aStream << self name << ' (' << self start asString << '-' << self stop asString << ')' 50 | ] 51 | 52 | { #category : 'accessing' } 53 | GtkTextStyleTag >> start [ 54 | 55 | ^ start 56 | ] 57 | 58 | { #category : 'accessing' } 59 | GtkTextStyleTag >> stop [ 60 | 61 | ^ stop 62 | ] 63 | -------------------------------------------------------------------------------- /src/Spec-Gtk/GtkToolbarAdapter.class.st: -------------------------------------------------------------------------------- 1 | Class { 2 | #name : 'GtkToolbarAdapter', 3 | #superclass : 'GtkAdapter', 4 | #category : 'Spec-Gtk-Adapter-Toolbar', 5 | #package : 'Spec-Gtk', 6 | #tag : 'Adapter-Toolbar' 7 | } 8 | 9 | { #category : 'building' } 10 | GtkToolbarAdapter >> addModelTo: gtkToolbar [ 11 | 12 | super addModelTo: gtkToolbar. 13 | 14 | self model whenItemsChangeDo: [ self updateItems: gtkToolbar ]. 15 | self updateItems: gtkToolbar 16 | ] 17 | 18 | { #category : 'building' } 19 | GtkToolbarAdapter >> buildButton: aButtonPresenter [ 20 | 21 | ^ aButtonPresenter build 22 | ] 23 | 24 | { #category : 'testing' } 25 | GtkToolbarAdapter >> hasButtonWithLabel: aString [ 26 | 27 | ^ self widget children anySatisfy: [ :e | 28 | (e isKindOf: GtkToolButton) and: [ e label = aString ] ] 29 | ] 30 | 31 | { #category : 'building' } 32 | GtkToolbarAdapter >> newWidget [ 33 | 34 | ^ GtkBox newHorizontal 35 | addClass: 'toolbar'; 36 | yourself 37 | ] 38 | 39 | { #category : 'building' } 40 | GtkToolbarAdapter >> numberOfItems [ 41 | 42 | ^ self widget size 43 | ] 44 | 45 | { #category : 'building' } 46 | GtkToolbarAdapter >> updateItems: gtkToolbar [ 47 | 48 | gtkToolbar removeAll. 49 | 50 | self model leftItems 51 | do: [ :each | gtkToolbar append: (self buildButton: each) ]. 52 | self model rightItems 53 | reverseDo: [ :each | 54 | gtkToolbar append: (self buildButton: each) ] 55 | ] 56 | -------------------------------------------------------------------------------- /src/Spec-Gtk/GtkRichTextAdapter.class.st: -------------------------------------------------------------------------------- 1 | Class { 2 | #name : 'GtkRichTextAdapter', 3 | #superclass : 'GtkTextAdapter', 4 | #category : 'Spec-Gtk-Adapter', 5 | #package : 'Spec-Gtk', 6 | #tag : 'Adapter' 7 | } 8 | 9 | { #category : 'building' } 10 | GtkRichTextAdapter >> addTextTo: gtkTextView [ 11 | | table attributes | 12 | table := GtkTextTagTable new. 13 | attributes := self model styleAttributes. 14 | attributes 15 | keysAndValuesDo: [ :name :value | 16 | | tag | 17 | tag := GtkTextTag newName: name. 18 | value do: [ :attribute | attribute acceptTag: tag ]. 19 | table add: tag ]. 20 | gtkTextView textBuffer: (self bufferClass newTable: table). 21 | gtkTextView textBuffer connectChanged: [ self applyStyleTo: gtkTextView ]. 22 | super addTextTo: gtkTextView 23 | ] 24 | 25 | { #category : 'building' } 26 | GtkRichTextAdapter >> applyStyleTo: textBuffer [ 27 | 28 | self halt 29 | "| tags visitor | 30 | 31 | visitor := GtkTextStyleTagsVisitor new. 32 | visitor styleProvider: self model styleAttributes. 33 | tags := visitor styleDocument: self model renderTree. 34 | tags do: [ :tag | tag acceptTextBuffer: textBuffer textBuffer ]" 35 | ] 36 | 37 | { #category : 'building' } 38 | GtkRichTextAdapter >> setText: text to: gtkWidget [ 39 | 40 | super 41 | setText: self presenter plaintext 42 | to: gtkWidget 43 | ] 44 | 45 | { #category : 'building' } 46 | GtkRichTextAdapter >> widgetClass [ 47 | 48 | ^ GtkRichTextView 49 | ] 50 | -------------------------------------------------------------------------------- /src/Spec-GtkBackendTests/GtkPopoverAdapterTest.class.st: -------------------------------------------------------------------------------- 1 | Class { 2 | #name : 'GtkPopoverAdapterTest', 3 | #superclass : 'TestCase', 4 | #instVars : [ 5 | 'app' 6 | ], 7 | #category : 'Spec-GtkBackendTests', 8 | #package : 'Spec-GtkBackendTests' 9 | } 10 | 11 | { #category : 'tests' } 12 | GtkPopoverAdapterTest >> testPopoverIsCorrectlyDestroyedWhenClose [ 13 | | presenter app oldWindowSize oldDisposeSize engine popover | 14 | 15 | engine := GEngine ensureRunning. 16 | 17 | app := SpApplication new useBackend: #Gtk. 18 | presenter := SpLabelPresenter newApplication: app. 19 | presenter open. 20 | 25 milliSeconds wait. 21 | 22 | oldWindowSize := engine windowRegistry size. 23 | oldDisposeSize := engine disposeRegistry size. 24 | 25 | popover := presenter newLabel asPopover. 26 | popover popup. 27 | popover presenter adapter widget autoReleaseWhenDisposedByGtk. 28 | 25 milliSeconds wait. 29 | 30 | self assert: app windows size equals: 2. 31 | self assert: engine windowRegistry size equals: oldWindowSize + 1. 32 | self assert: engine disposeRegistry size equals: oldDisposeSize + 1. 33 | 34 | popover dismiss. 35 | popover := nil. 36 | 3 timesRepeat: [ Smalltalk garbageCollect ]. 37 | 20 milliSeconds wait. 38 | 39 | self assert: app windows size equals: 1. 40 | self assert: engine windowRegistry size equals: oldWindowSize. 41 | self assert: engine disposeRegistry size equals: oldDisposeSize. 42 | 43 | presenter window close. 44 | presenter := nil 45 | ] 46 | -------------------------------------------------------------------------------- /src/Spec-Gtk/GtkToolbarToggleButtonAdapter.class.st: -------------------------------------------------------------------------------- 1 | Class { 2 | #name : 'GtkToolbarToggleButtonAdapter', 3 | #superclass : 'GtkToolbarBaseButtonAdapter', 4 | #category : 'Spec-Gtk-Adapter-Toolbar', 5 | #package : 'Spec-Gtk', 6 | #tag : 'Adapter-Toolbar' 7 | } 8 | 9 | { #category : 'building' } 10 | GtkToolbarToggleButtonAdapter >> addModelTo: gtkToolButton [ 11 | 12 | super addModelTo: gtkToolButton. 13 | gtkToolButton active: self presenter state 14 | ] 15 | 16 | { #category : 'building' } 17 | GtkToolbarToggleButtonAdapter >> newWidget [ 18 | 19 | ^ GtkToggleButton new 20 | addClass: 'image-button'; 21 | addClass: 'toolbar-button'; 22 | yourself 23 | ] 24 | 25 | { #category : 'private' } 26 | GtkToolbarToggleButtonAdapter >> performAction [ 27 | 28 | self widgetDo: [ :w | 29 | self presenter state: w isActive ]. 30 | super performAction 31 | ] 32 | 33 | { #category : 'building' } 34 | GtkToolbarToggleButtonAdapter >> updatePresenterState [ 35 | | state | 36 | 37 | self widgetDo: [ :w | 38 | state := self presenter state. 39 | state ifTrue: [ 40 | self presenter associatedToggleButtons 41 | do: [ :each | each state: false ] ]. 42 | w active: state ] 43 | ] 44 | 45 | { #category : 'building' } 46 | GtkToolbarToggleButtonAdapter >> updateState [ 47 | | state | 48 | 49 | self widgetDo: [ :w | 50 | state := w active. 51 | state ifTrue: [ 52 | self presenter associatedToggleButtons 53 | do: [ :each | each state: false ] ]. 54 | self presenter execute: state ] 55 | ] 56 | -------------------------------------------------------------------------------- /src/Spec-Gtk/GtkDropDownAdapterLabelFactory.class.st: -------------------------------------------------------------------------------- 1 | " 2 | A factory used to provide labels to GtkDropDownAdapter. 3 | This is the element that will be shown in the selected part. 4 | " 5 | Class { 6 | #name : 'GtkDropDownAdapterLabelFactory', 7 | #superclass : 'GtkListViewAdapterBaseFactory', 8 | #instVars : [ 9 | 'setupAction', 10 | 'bindAction' 11 | ], 12 | #category : 'Spec-Gtk-Adapter-ListView', 13 | #package : 'Spec-Gtk', 14 | #tag : 'Adapter-ListView' 15 | } 16 | 17 | { #category : 'accessing' } 18 | GtkDropDownAdapterLabelFactory >> bind: listItem to: anObject [ 19 | | child | 20 | 21 | child := self presenterAtHandle: listItem child. 22 | child ifNil: [ ^ self ]. 23 | 24 | self bindAction 25 | value: child 26 | value: anObject 27 | ] 28 | 29 | { #category : 'accessing' } 30 | GtkDropDownAdapterLabelFactory >> bindAction [ 31 | 32 | ^ bindAction ifNil: [ 33 | bindAction := [ :aPresenter :anObject | 34 | aPresenter label: (anObject 35 | ifNotNil: [ (self presenter display value: anObject) ] 36 | ifNil: [ '(None)' ]) ] ] 37 | ] 38 | 39 | { #category : 'accessing' } 40 | GtkDropDownAdapterLabelFactory >> setup: listItem [ 41 | | child | 42 | 43 | child := self setupAction cull: presenter. 44 | child build. 45 | 46 | self storePresenter: child. 47 | 48 | listItem child: child adapter widget 49 | ] 50 | 51 | { #category : 'accessing' } 52 | GtkDropDownAdapterLabelFactory >> setupAction [ 53 | 54 | ^ setupAction ifNil: [ setupAction := [ :aPresenter | aPresenter newLabel ] ] 55 | ] 56 | -------------------------------------------------------------------------------- /src/Spec-Gtk/GtkTreeColumnViewAdapterItemFactory.class.st: -------------------------------------------------------------------------------- 1 | Class { 2 | #name : 'GtkTreeColumnViewAdapterItemFactory', 3 | #superclass : 'GtkColumnViewAdapterItemFactory', 4 | #instVars : [ 5 | 'store' 6 | ], 7 | #category : 'Spec-Gtk-Adapter-ListView', 8 | #package : 'Spec-Gtk', 9 | #tag : 'Adapter-ListView' 10 | } 11 | 12 | { #category : 'accessing' } 13 | GtkTreeColumnViewAdapterItemFactory >> bind: listItem [ 14 | | child row itemReference itemStore item | 15 | 16 | row := GtkTreeListRow fromHandleUnreferenced: listItem item getHandle. 17 | child := self presenterAtHandle: listItem child getHandle. 18 | child ifNil: [ ^ self ]. 19 | 20 | itemReference := row item. 21 | itemStore := store storeAt: (itemReference dataAt: 'store'). 22 | item := itemStore itemAtHandle: itemReference getHandle. 23 | itemReference objectUnref. 24 | 25 | self column bindAction 26 | value: child 27 | value: item 28 | ] 29 | 30 | { #category : 'accessing' } 31 | GtkTreeColumnViewAdapterItemFactory >> bind: listItem to: anObject [ 32 | 33 | self error: 'Should not arrive here' 34 | ] 35 | 36 | { #category : 'accessing' } 37 | GtkTreeColumnViewAdapterItemFactory >> setup: listItem [ 38 | | child | 39 | 40 | child := self column setupAction cull: presenter. 41 | child build. 42 | 43 | self storePresenter: child. 44 | listItem child: child adapter widget 45 | ] 46 | 47 | { #category : 'accessing' } 48 | GtkTreeColumnViewAdapterItemFactory >> store: aRootStore [ 49 | 50 | store := aRootStore. 51 | storedObjects removeAll 52 | ] 53 | -------------------------------------------------------------------------------- /src/Spec-Gtk/GtkListViewAdapterHeaderFactory.class.st: -------------------------------------------------------------------------------- 1 | " 2 | Header factory for to be used with `GtkListViewAdapter` 3 | " 4 | Class { 5 | #name : 'GtkListViewAdapterHeaderFactory', 6 | #superclass : 'GtkListViewAdapterBaseFactory', 7 | #category : 'Spec-Gtk-Adapter-ListView', 8 | #package : 'Spec-Gtk', 9 | #tag : 'Adapter-ListView' 10 | } 11 | 12 | { #category : 'accessing' } 13 | GtkListViewAdapterHeaderFactory >> bind: listItem [ 14 | 15 | self 16 | bind: listItem 17 | to: (self itemAt: (listItem start + 1)) 18 | ] 19 | 20 | { #category : 'accessing' } 21 | GtkListViewAdapterHeaderFactory >> bind: listItem to: anObject [ 22 | "| child | 23 | 24 | child := self presenterAtHandle: listItem child. 25 | child label: anObject asString" 26 | ] 27 | 28 | { #category : 'private' } 29 | GtkListViewAdapterHeaderFactory >> itemAt: aPosition [ 30 | 31 | ^ self presenter headerTitle 32 | ] 33 | 34 | { #category : 'private' } 35 | GtkListViewAdapterHeaderFactory >> listItemClass [ 36 | 37 | ^ GtkListHeader 38 | ] 39 | 40 | { #category : 'accessing' } 41 | GtkListViewAdapterHeaderFactory >> setup: listItem [ 42 | | child | 43 | 44 | child := presenter newPresenter. 45 | child layout: SpBoxLayout newHorizontal. 46 | child addStyle: 'columnview-header'. 47 | 48 | presenter columns do: [ :each | 49 | child layout add: (child newButton 50 | label: each title; 51 | yourself) ]. 52 | 53 | "child := presenter newButton." 54 | child build. 55 | 56 | self storePresenter: child. 57 | 58 | listItem child: child adapter widget 59 | ] 60 | -------------------------------------------------------------------------------- /src/Spec-Gtk-Code/GtkCodeCompletionEngine.class.st: -------------------------------------------------------------------------------- 1 | Class { 2 | #name : 'GtkCodeCompletionEngine', 3 | #superclass : 'Object', 4 | #instVars : [ 5 | 'scripting', 6 | 'completionClass', 7 | 'doItContext', 8 | 'doItRequestor' 9 | ], 10 | #category : 'Spec-Gtk-Code-Base', 11 | #package : 'Spec-Gtk-Code', 12 | #tag : 'Base' 13 | } 14 | 15 | { #category : 'accessing' } 16 | GtkCodeCompletionEngine >> completionClass [ 17 | 18 | ^ completionClass 19 | ] 20 | 21 | { #category : 'accessing' } 22 | GtkCodeCompletionEngine >> completionClass: anObject [ 23 | 24 | completionClass := anObject 25 | ] 26 | 27 | { #category : 'accessing' } 28 | GtkCodeCompletionEngine >> doItContext [ 29 | 30 | ^ doItContext 31 | ] 32 | 33 | { #category : 'accessing' } 34 | GtkCodeCompletionEngine >> doItContext: aContext [ 35 | 36 | doItContext := aContext 37 | ] 38 | 39 | { #category : 'accessing' } 40 | GtkCodeCompletionEngine >> doItRequestor [ 41 | 42 | ^ doItRequestor 43 | ] 44 | 45 | { #category : 'accessing' } 46 | GtkCodeCompletionEngine >> doItRequestor: aRequestor [ 47 | 48 | doItRequestor := aRequestor 49 | ] 50 | 51 | { #category : 'testing' } 52 | GtkCodeCompletionEngine >> isScripting [ 53 | 54 | ^ scripting 55 | ] 56 | 57 | { #category : 'accessing' } 58 | GtkCodeCompletionEngine >> scripting: aBoolean [ 59 | 60 | scripting := aBoolean 61 | ] 62 | 63 | { #category : 'accessing' } 64 | GtkCodeCompletionEngine >> variableBindingNames [ 65 | 66 | ^ self doItRequestor 67 | ifNotNil: [ :aRequestor | aRequestor variableBindingNames ] 68 | ifNil: [ #() ] 69 | ] 70 | -------------------------------------------------------------------------------- /src/Spec-Gtk/GtkToggleButtonAdapter.class.st: -------------------------------------------------------------------------------- 1 | Class { 2 | #name : 'GtkToggleButtonAdapter', 3 | #superclass : 'GtkButtonAdapter', 4 | #category : 'Spec-Gtk-Adapter', 5 | #package : 'Spec-Gtk', 6 | #tag : 'Adapter' 7 | } 8 | 9 | { #category : 'updating' } 10 | GtkToggleButtonAdapter >> addActionTo: gtkToggleButton [ 11 | 12 | gtkToggleButton connectToggled: [ 13 | self backendUpdatingDo: [ self updatePresenterState ] ]. 14 | self presenter whenChangedDo: [ 15 | self withCycleDetectionOnBackendDo: [ self updateState ] ] 16 | ] 17 | 18 | { #category : 'building' } 19 | GtkToggleButtonAdapter >> setIconTo: gtkToggleButton [ 20 | 21 | gtkToggleButton image: self presenter icon asGtkImage 22 | ] 23 | 24 | { #category : 'updating' } 25 | GtkToggleButtonAdapter >> updatePresenterState [ 26 | 27 | self widgetDo: [ :w | 28 | self updatePresenterStateOn: w ] 29 | ] 30 | 31 | { #category : 'updating' } 32 | GtkToggleButtonAdapter >> updatePresenterStateOn: gtkToggleButton [ 33 | | active | 34 | 35 | active := gtkToggleButton isActive. 36 | active ifTrue: [ 37 | self presenter associatedToggleButtons 38 | do: [ :each | each state: false ] ]. 39 | self presenter state: active 40 | ] 41 | 42 | { #category : 'updating' } 43 | GtkToggleButtonAdapter >> updateState [ 44 | 45 | self widgetDo: [ :w | 46 | self state ifTrue: [ 47 | self presenter associatedToggleButtons 48 | do: [ :each | each state: false ] ]. 49 | super updateState ] 50 | ] 51 | 52 | { #category : 'factory' } 53 | GtkToggleButtonAdapter >> widgetClass [ 54 | 55 | ^ GtkToggleButton 56 | ] 57 | -------------------------------------------------------------------------------- /src/Spec-Gtk/GtkTTableAccessing.trait.st: -------------------------------------------------------------------------------- 1 | Trait { 2 | #name : 'GtkTTableAccessing', 3 | #category : 'Spec-Gtk-Adapter-Table', 4 | #package : 'Spec-Gtk', 5 | #tag : 'Adapter-Table' 6 | } 7 | 8 | { #category : 'building' } 9 | GtkTTableAccessing >> addColumn: aTableColumn to: aGtkTreeView [ 10 | | addColumnVisitor | 11 | 12 | addColumnVisitor := GtkTableColumnBuilder new 13 | model: self presenter; 14 | resizable: self presenter isResizable; 15 | columns: self presenter columns; 16 | view: aGtkTreeView; 17 | yourself. 18 | 19 | aTableColumn acceptColumnVisitor: addColumnVisitor 20 | ] 21 | 22 | { #category : 'building' } 23 | GtkTTableAccessing >> addColumnsTo: gtkWidget [ 24 | 25 | self model columns do: [ :aColumn | 26 | self addColumn: aColumn to: gtkWidget ]. 27 | ] 28 | 29 | { #category : 'factory' } 30 | GtkTTableAccessing >> newTreeStore [ 31 | 32 | ^ self newTreeStoreFrom: self presenter model items 33 | ] 34 | 35 | { #category : 'factory' } 36 | GtkTTableAccessing >> newTreeStoreFrom: items [ 37 | | store | 38 | 39 | store := GtkTreeDataStore new. 40 | store beList. 41 | GtkTableDataStoreColumnCollector new 42 | store: store; 43 | visitAll: self tableColumns. 44 | 45 | store roots: items. 46 | 47 | "configure drag&drop" 48 | store dragEnabled: self presenter dragEnabled. 49 | self presenter dropEnabled ifTrue: [ 50 | store 51 | dropEnabled: true; 52 | acceptDrop: self presenter acceptDrop ]. 53 | 54 | ^ store 55 | ] 56 | 57 | { #category : 'factory' } 58 | GtkTTableAccessing >> tableColumns [ 59 | 60 | ^ self model columns 61 | ] 62 | -------------------------------------------------------------------------------- /src/Spec-Gtk/GtkTreeListViewAdapterDataStore.class.st: -------------------------------------------------------------------------------- 1 | " 2 | A data store to be used in `GtkListViewAdapter` 3 | " 4 | Class { 5 | #name : 'GtkTreeListViewAdapterDataStore', 6 | #superclass : 'GTreeListReferenceStore', 7 | #instVars : [ 8 | 'presenter' 9 | ], 10 | #category : 'Spec-Gtk-Adapter-ListView', 11 | #package : 'Spec-Gtk', 12 | #tag : 'Adapter-ListView' 13 | } 14 | 15 | { #category : 'instance creation' } 16 | GtkTreeListViewAdapterDataStore class >> newPresenter: aPresenter [ 17 | 18 | ^ self new 19 | presenter: aPresenter; 20 | yourself 21 | ] 22 | 23 | { #category : 'accessing' } 24 | GtkTreeListViewAdapterDataStore >> items [ 25 | 26 | ^ items ifNil: [ 27 | items := self presenter roots 28 | ifNotNil: [ :aCollection | aCollection copy ] 29 | ifNil: [ #() ] ] 30 | ] 31 | 32 | { #category : 'accessing' } 33 | GtkTreeListViewAdapterDataStore >> items: aCollection [ 34 | 35 | items := aCollection 36 | ] 37 | 38 | { #category : 'accessing' } 39 | GtkTreeListViewAdapterDataStore >> presenter [ 40 | 41 | ^ presenter 42 | ] 43 | 44 | { #category : 'accessing' } 45 | GtkTreeListViewAdapterDataStore >> presenter: aPresenter [ 46 | 47 | presenter := aPresenter. 48 | self reset 49 | ] 50 | 51 | { #category : 'private' } 52 | GtkTreeListViewAdapterDataStore >> pushStore: aStore [ 53 | 54 | ^ (super pushStore: aStore) 55 | presenter: self presenter; 56 | yourself 57 | ] 58 | 59 | { #category : 'private' } 60 | GtkTreeListViewAdapterDataStore >> storedPresenters [ 61 | 62 | stores ifNil: [ ^ #() ]. 63 | ^ stores flatCollect: [ :each | each storedPresenters ] 64 | ] 65 | -------------------------------------------------------------------------------- /src/Spec-Gtk/GtkToolbarBaseButtonAdapter.class.st: -------------------------------------------------------------------------------- 1 | Class { 2 | #name : 'GtkToolbarBaseButtonAdapter', 3 | #superclass : 'GtkBaseButtonAdapter', 4 | #category : 'Spec-Gtk-Adapter-Toolbar', 5 | #package : 'Spec-Gtk', 6 | #tag : 'Adapter-Toolbar' 7 | } 8 | 9 | { #category : 'building' } 10 | GtkToolbarBaseButtonAdapter >> addActionTo: gtkButton [ 11 | 12 | gtkButton connectClicked: [ 13 | self runInSystem: [ [ self performAction ] fork ] ] 14 | ] 15 | 16 | { #category : 'building' } 17 | GtkToolbarBaseButtonAdapter >> addModelTo: gtkButton [ 18 | 19 | super addModelTo: gtkButton. 20 | self addActionTo: gtkButton 21 | ] 22 | 23 | { #category : 'testing' } 24 | GtkToolbarBaseButtonAdapter >> hasIcon [ 25 | 26 | ^ self presenter owner displayMode hasIcon 27 | and: [ self presenter icon notNil ] 28 | ] 29 | 30 | { #category : 'testing' } 31 | GtkToolbarBaseButtonAdapter >> hasLabel [ 32 | 33 | ^ self presenter owner displayMode hasLabel 34 | ] 35 | 36 | { #category : 'private' } 37 | GtkToolbarBaseButtonAdapter >> labelAndIcon [ 38 | | box gtkIcon gtkLabel | 39 | 40 | box := GtkBox newVertical 41 | vAlignCenter; 42 | spacing: 3; 43 | yourself. 44 | 45 | gtkIcon := GtkImage new. 46 | gtkIcon vExpand: false. 47 | box append: gtkIcon. 48 | gtkIcon visible: false. 49 | 50 | gtkLabel := GtkLabel new. 51 | box append: gtkLabel. 52 | gtkLabel visible: false. 53 | 54 | ^ box 55 | ] 56 | 57 | { #category : 'building' } 58 | GtkToolbarBaseButtonAdapter >> newWidget [ 59 | 60 | ^ GtkButton new 61 | ] 62 | 63 | { #category : 'private' } 64 | GtkToolbarBaseButtonAdapter >> performAction [ 65 | 66 | self presenter performAction 67 | ] 68 | -------------------------------------------------------------------------------- /src/Spec-Gtk/GtkMenuAdapter.class.st: -------------------------------------------------------------------------------- 1 | Class { 2 | #name : 'GtkMenuAdapter', 3 | #superclass : 'GtkMenuBaseAdapter', 4 | #category : 'Spec-Gtk-Adapter-Menu', 5 | #package : 'Spec-Gtk', 6 | #tag : 'Adapter-Menu' 7 | } 8 | 9 | { #category : 'building' } 10 | GtkMenuAdapter >> addModelTo: gtkWidget [ 11 | 12 | self model menuGroups 13 | do: [ :eachGroup | 14 | eachGroup menuItems 15 | do: [ :each | gtkWidget add: each build ] ] 16 | separatedBy: [ 17 | gtkWidget add: (GtkSeparatorMenuItem new 18 | show; 19 | yourself) ] 20 | ] 21 | 22 | { #category : 'accessing' } 23 | GtkMenuAdapter >> openAt: aPosition [ 24 | 25 | self presenter application registerWindow: self presenter. 26 | "I need to execute this outside this current render cycle, because otherwise the 27 | gtk render loop assumes the action is over and it disposes the menu, that's the 28 | reason of the schedule" 29 | [ 30 | 150 milliSeconds wait. 31 | self widgetDo: [ :w | 32 | w connectHide: [ self presenter application unregisterWindow: self presenter ]. 33 | w showAll. 34 | w popupAtPointer: (GdkButtonEvent newButtonRelease 35 | window: self presenter window adapter widget gdkWindow; 36 | device: GdkDisplay default defaultSeat pointer; 37 | time: Time millisecondClockValue; 38 | x: aPosition x asFloat; 39 | y: aPosition y asFloat; 40 | yourself) ] 41 | ] schedule 42 | ] 43 | 44 | { #category : 'accessing' } 45 | GtkMenuAdapter >> openAtPointer [ 46 | 47 | self openAt: GdkDisplay default defaultSeat pointer position 48 | ] 49 | 50 | { #category : 'accessing' } 51 | GtkMenuAdapter >> widgetClass [ 52 | 53 | ^ GtkMenu 54 | ] 55 | -------------------------------------------------------------------------------- /src/Spec-GtkBackendTests/GtkTextStyleVisitorTest.class.st: -------------------------------------------------------------------------------- 1 | Class { 2 | #name : 'GtkTextStyleVisitorTest', 3 | #superclass : 'TestCase', 4 | #instVars : [ 5 | 'visitor' 6 | ], 7 | #category : 'Spec-GtkBackendTests', 8 | #package : 'Spec-GtkBackendTests' 9 | } 10 | 11 | { #category : 'accessing' } 12 | GtkTextStyleVisitorTest class >> syntaxInAPostcard [ 13 | 14 | ^ 'exampleWithNumber: x 15 | 16 | "A method that illustrates every part of Smalltalk method syntax 17 | except primitives. It has unary, binary, and keyword messages, 18 | declares arguments and temporaries, accesses a global variable 19 | (but not and instance variable), uses literals (array, character, 20 | symbol, string, integer, float), uses the pseudo variables 21 | true false, nil, self, and super, and has sequence, assignment, 22 | return and cascade. It has both zero argument and one argument blocks." 23 | 24 | |y| 25 | true & false not & (nil isNil) ifFalse: [self halt]. 26 | y := self size + super size. 27 | #($a #a "a" 1 1.0) 28 | do: [:each | 29 | Transcript 30 | show: (each class name); 31 | show: '' '']. 32 | ^ x < y' 33 | ] 34 | 35 | { #category : 'running' } 36 | GtkTextStyleVisitorTest >> setUp [ 37 | 38 | super setUp. 39 | visitor := GtkTextStyleVisitor new 40 | ] 41 | 42 | { #category : 'tests' } 43 | GtkTextStyleVisitorTest >> testStyleMethod [ 44 | | tags | 45 | 46 | "smoke test" 47 | visitor 48 | contextClass: Object; 49 | styleMethod: self class syntaxInAPostcard. 50 | "basic test" 51 | tags := visitor 52 | contextClass: Object; 53 | styleMethod: 'self asString'. 54 | 55 | self assert: tags size equals: 2 56 | ] 57 | -------------------------------------------------------------------------------- /src/Spec-Gtk/GtkAthensAdapter.class.st: -------------------------------------------------------------------------------- 1 | Class { 2 | #name : 'GtkAthensAdapter', 3 | #superclass : 'GtkAdapter', 4 | #category : 'Spec-Gtk-Adapter', 5 | #package : 'Spec-Gtk', 6 | #tag : 'Adapter' 7 | } 8 | 9 | { #category : 'building' } 10 | GtkAthensAdapter >> addModelTo: gtkDrawingArea [ 11 | 12 | super addModelTo: gtkDrawingArea. 13 | self ensureCanAnswerEvents: gtkDrawingArea. 14 | gtkDrawingArea drawBlock: [ :cr :boundingBox | 15 | (AthensCairoCanvas fromHandle: cr) surface drawDuring: [ :canvas | 16 | self presenter drawBlock 17 | value: canvas 18 | value: boundingBox ] ]. 19 | gtkDrawingArea extent: self presenter surfaceExtent. 20 | "gtkDrawingArea addVerticalScrollEvent: [ :event | event crTrace. false ]." 21 | self presenter 22 | whenDrawBlockChangedDo: [ :newBlock | self updateDrawBlock: newBlock ]. 23 | self presenter 24 | whenExtentChangedDo: [ :newExtent | self widget extent: newExtent ] 25 | ] 26 | 27 | { #category : 'private' } 28 | GtkAthensAdapter >> ensureCanAnswerEvents: gtkDrawingArea [ 29 | 30 | gtkDrawingArea canFocus: true. 31 | gtkDrawingArea registerToAllEvents 32 | ] 33 | 34 | { #category : 'private - actions' } 35 | GtkAthensAdapter >> newActionManager [ 36 | 37 | ^ GtkAdapterActionDrawingAreaManager on: self 38 | ] 39 | 40 | { #category : 'drawing' } 41 | GtkAthensAdapter >> redraw [ 42 | 43 | self widgetDo: [ :w | w queueDraw ] 44 | ] 45 | 46 | { #category : 'private' } 47 | GtkAthensAdapter >> updateDrawBlock: aBlock [ 48 | 49 | self widgetDo: [ :w | 50 | w 51 | drawBlock: aBlock; 52 | queueDraw ] 53 | ] 54 | 55 | { #category : 'building' } 56 | GtkAthensAdapter >> widgetClass [ 57 | 58 | ^ GtkBlockBasedDrawingArea 59 | ] 60 | -------------------------------------------------------------------------------- /src/Spec-Gtk/GtkTreeAdapter.class.st: -------------------------------------------------------------------------------- 1 | Class { 2 | #name : 'GtkTreeAdapter', 3 | #superclass : 'GtkTreeTableAdapter', 4 | #instVars : [ 5 | 'columns' 6 | ], 7 | #category : 'Spec-Gtk-Adapter-Table', 8 | #package : 'Spec-Gtk', 9 | #tag : 'Adapter-Table' 10 | } 11 | 12 | { #category : 'private accessing' } 13 | GtkTreeAdapter >> columns [ 14 | 15 | ^ columns ifNil: [ columns := { self defaultColumn } ] 16 | ] 17 | 18 | { #category : 'building' } 19 | GtkTreeAdapter >> connectToSpecColumnsChangedEventTo: gtkWidget [ 20 | ] 21 | 22 | { #category : 'private accessing' } 23 | GtkTreeAdapter >> defaultColumn [ 24 | | column | 25 | 26 | column := SpStringTableColumn evaluated: self presenter display. 27 | 28 | self presenter displayAlignment 29 | ifNotNil: [ :aBlock | column displayAlignment: aBlock ]. 30 | self presenter displayColor 31 | ifNotNil: [ :aBlock | column displayColor: aBlock ]. 32 | self presenter displayBold 33 | ifNotNil: [ :aBlock | column displayBold: aBlock ]. 34 | self presenter displayItalic 35 | ifNotNil: [ :aBlock | column displayItalic: aBlock ]. 36 | self presenter displayUnderline 37 | ifNotNil: [ :aBlock | column displayUnderline: aBlock ]. 38 | self presenter displayBackgroundColor 39 | ifNotNil: [ :aBlock | column displayBackgroundColor: aBlock ]. 40 | 41 | ^ self presenter displayIcon 42 | ifNotNil: [ 43 | SpCompositeTableColumn new 44 | addColumn: (SpImageTableColumn evaluated: self presenter displayIcon) beNotExpandable; 45 | addColumn: column; 46 | yourself ] 47 | ifNil: [ column ] 48 | ] 49 | 50 | { #category : 'private accessing' } 51 | GtkTreeAdapter >> unsubscirbeSelectionMode [ 52 | 53 | "do nothing here" 54 | ] 55 | -------------------------------------------------------------------------------- /src/Spec-Gtk-Alexandrie/GtkAlexandrieAdapter.class.st: -------------------------------------------------------------------------------- 1 | Class { 2 | #name : 'GtkAlexandrieAdapter', 3 | #superclass : 'GtkAdapter', 4 | #category : 'Spec-Gtk-Alexandrie', 5 | #package : 'Spec-Gtk-Alexandrie' 6 | } 7 | 8 | { #category : 'building' } 9 | GtkAlexandrieAdapter >> addModelTo: gtkDrawingArea [ 10 | 11 | super addModelTo: gtkDrawingArea. 12 | self ensureCanAnswerEvents: gtkDrawingArea. 13 | gtkDrawingArea drawBlock: [ :cr :boundingBox | 14 | self presenter drawBlock 15 | value: (AeCairoContext basicNew 16 | setHandle: cr; 17 | yourself) 18 | value: boundingBox ]. 19 | gtkDrawingArea extent: self presenter surfaceExtent. 20 | "gtkDrawingArea addVerticalScrollEvent: [ :event | event crTrace. false ]." 21 | self presenter 22 | whenDrawBlockChangedDo: [ :newBlock | self updateDrawBlock: newBlock ]. 23 | self presenter 24 | whenExtentChangedDo: [ :newExtent | self widget extent: newExtent ] 25 | ] 26 | 27 | { #category : 'private' } 28 | GtkAlexandrieAdapter >> ensureCanAnswerEvents: gtkDrawingArea [ 29 | 30 | gtkDrawingArea canFocus: true. 31 | gtkDrawingArea registerToAllEvents 32 | ] 33 | 34 | { #category : 'private - actions' } 35 | GtkAlexandrieAdapter >> newActionManager [ 36 | 37 | ^ GtkAdapterActionDrawingAreaManager on: self 38 | ] 39 | 40 | { #category : 'drawing' } 41 | GtkAlexandrieAdapter >> redraw [ 42 | 43 | self widgetDo: [ :w | w queueDraw ] 44 | ] 45 | 46 | { #category : 'private' } 47 | GtkAlexandrieAdapter >> updateDrawBlock: aBlock [ 48 | 49 | self widgetDo: [ :w | 50 | w 51 | drawBlock: aBlock; 52 | queueDraw ] 53 | ] 54 | 55 | { #category : 'building' } 56 | GtkAlexandrieAdapter >> widgetClass [ 57 | 58 | ^ GtkBlockBasedDrawingArea 59 | ] 60 | -------------------------------------------------------------------------------- /src/Spec-Gtk-Keybindings/KeyboardKey.extension.st: -------------------------------------------------------------------------------- 1 | Extension { #name : #KeyboardKey } 2 | 3 | { #category : #'*Spec-Gtk-Keybindings' } 4 | KeyboardKey class >> F1 [ 5 | 6 | ^ self value: 65470 7 | ] 8 | 9 | { #category : #'*Spec-Gtk-Keybindings' } 10 | KeyboardKey class >> F10 [ 11 | 12 | ^ self value: 65479 13 | ] 14 | 15 | { #category : #'*Spec-Gtk-Keybindings' } 16 | KeyboardKey class >> F11 [ 17 | 18 | ^ self value: 65480 19 | ] 20 | 21 | { #category : #'*Spec-Gtk-Keybindings' } 22 | KeyboardKey class >> F12 [ 23 | 24 | ^ self value: 65481 25 | ] 26 | 27 | { #category : #'*Spec-Gtk-Keybindings' } 28 | KeyboardKey class >> F2 [ 29 | 30 | ^ self value: 65471 31 | ] 32 | 33 | { #category : #'*Spec-Gtk-Keybindings' } 34 | KeyboardKey class >> F3 [ 35 | 36 | ^ self value: 65472 37 | ] 38 | 39 | { #category : #'*Spec-Gtk-Keybindings' } 40 | KeyboardKey class >> F4 [ 41 | 42 | ^ self value: 65473 43 | ] 44 | 45 | { #category : #'*Spec-Gtk-Keybindings' } 46 | KeyboardKey class >> F5 [ 47 | 48 | ^ self value: 65474 49 | ] 50 | 51 | { #category : #'*Spec-Gtk-Keybindings' } 52 | KeyboardKey class >> F6 [ 53 | 54 | ^ self value: 65475 55 | ] 56 | 57 | { #category : #'*Spec-Gtk-Keybindings' } 58 | KeyboardKey class >> F7 [ 59 | 60 | ^ self value: 65476 61 | ] 62 | 63 | { #category : #'*Spec-Gtk-Keybindings' } 64 | KeyboardKey class >> F8 [ 65 | 66 | ^ self value: 65477 67 | ] 68 | 69 | { #category : #'*Spec-Gtk-Keybindings' } 70 | KeyboardKey class >> F9 [ 71 | 72 | ^ self value: 65478 73 | ] 74 | 75 | { #category : #'*Spec-Gtk-Keybindings' } 76 | KeyboardKey class >> atValue: aKeyValue ifAbsent: aBlock [ 77 | 78 | ^ KeyCodeTable 79 | at: aKeyValue 80 | ifAbsent: aBlock 81 | ] 82 | -------------------------------------------------------------------------------- /src/Spec-Gtk/GtkActionInstaller.class.st: -------------------------------------------------------------------------------- 1 | " 2 | installs the actions into a presenter. 3 | " 4 | Class { 5 | #name : 'GtkActionInstaller', 6 | #superclass : 'GtkActionVisitor', 7 | #instVars : [ 8 | 'actionGroup', 9 | 'actionMap' 10 | ], 11 | #category : 'Spec-Gtk-Actions', 12 | #package : 'Spec-Gtk', 13 | #tag : 'Actions' 14 | } 15 | 16 | { #category : 'accessing' } 17 | GtkActionInstaller >> actionGroup [ 18 | 19 | ^ actionGroup ifNil: [ actionGroup := GSimpleActionGroup new ] 20 | ] 21 | 22 | { #category : 'accessing' } 23 | GtkActionInstaller >> actionGroup: anActionGroup [ 24 | 25 | actionGroup := anActionGroup 26 | ] 27 | 28 | { #category : 'visiting' } 29 | GtkActionInstaller >> visit: anObject [ 30 | 31 | actionMap := Dictionary new. 32 | super visit: anObject. 33 | ^ actionMap 34 | ] 35 | 36 | { #category : 'visiting' } 37 | GtkActionInstaller >> visitCommand: aCommand [ 38 | | action | 39 | 40 | action := (GSimpleAction newName: aCommand id) 41 | connectActivate: [ 42 | self runInSystem: [ 43 | aCommand canBeExecuted 44 | ifTrue: [ [ aCommand execute ] fork ] ] ]; 45 | yourself. 46 | 47 | actionMap at: aCommand put: action. 48 | self actionGroup insert: action 49 | ] 50 | 51 | { #category : 'visiting' } 52 | GtkActionInstaller >> visitCommandGroup: aCommandGroup [ 53 | | oldActionGroup | 54 | 55 | self pushPrefix: aCommandGroup. 56 | oldActionGroup := actionGroup. 57 | [ 58 | actionGroup := GSimpleActionGroup new. 59 | aCommandGroup entries do: [ :entry | entry acceptVisitor: self ]. 60 | self widget 61 | insertActionGroup: self prefix 62 | actions: self actionGroup ] 63 | ensure: [ 64 | actionGroup := oldActionGroup. 65 | self popPrefix ] 66 | ] 67 | -------------------------------------------------------------------------------- /src/Spec-Gtk/GtkToolbarMenuButtonAdapter.class.st: -------------------------------------------------------------------------------- 1 | Class { 2 | #name : 'GtkToolbarMenuButtonAdapter', 3 | #superclass : 'GtkToolbarBaseButtonAdapter', 4 | #instVars : [ 5 | 'menuWidget' 6 | ], 7 | #category : 'Spec-Gtk-Adapter-Toolbar', 8 | #package : 'Spec-Gtk', 9 | #tag : 'Adapter-Toolbar' 10 | } 11 | 12 | { #category : 'private' } 13 | GtkToolbarMenuButtonAdapter >> addModelTo: gtkToolButton [ 14 | 15 | super addModelTo: gtkToolButton. 16 | gtkToolButton connectClicked: [ 17 | self runInSystem: [ self presenter action value ] ]. 18 | self updateMenuTo: gtkToolButton. 19 | gtkToolButton connectShowMenu: [ self updateMenu ] 20 | ] 21 | 22 | { #category : 'building' } 23 | GtkToolbarMenuButtonAdapter >> buildMenu: menuPresenter [ 24 | 25 | menuPresenter owner: self presenter. 26 | menuWidget := SpBindings 27 | value: self presenter application adapterBindings 28 | during: [ menuPresenter build ]. 29 | ^ menuWidget 30 | ] 31 | 32 | { #category : 'accessing' } 33 | GtkToolbarMenuButtonAdapter >> icon [ 34 | 35 | ^ self presenter icon 36 | ifNotNil: [ :icon | icon asGtkImage ] 37 | ifNil: [ GtkImage null ] 38 | ] 39 | 40 | { #category : 'building' } 41 | GtkToolbarMenuButtonAdapter >> newWidget [ 42 | 43 | ^ GtkMenuToolButton 44 | newIcon: self icon 45 | label: (self presenter label ifNil: [ '' ]) 46 | ] 47 | 48 | { #category : 'updating' } 49 | GtkToolbarMenuButtonAdapter >> updateMenu [ 50 | 51 | self widgetDo: [ :w | self updateMenuTo: w ] 52 | ] 53 | 54 | { #category : 'updating' } 55 | GtkToolbarMenuButtonAdapter >> updateMenuTo: aWidget [ 56 | 57 | self presenter menu ifNotNil: [ :aValuable | 58 | aValuable value ifNotNil: [ :aMenu | 59 | aWidget menu: (self buildMenu: aMenu) ] ] 60 | ] 61 | -------------------------------------------------------------------------------- /src/Spec-Gtk/SpGtkBannerPresenter.class.st: -------------------------------------------------------------------------------- 1 | " 2 | A presenter to create a banner, an information area that will be displayed on top of a window. 3 | This simulates AdwBanner from libadwaita (https://gnome.pages.gitlab.gnome.org/libadwaita/doc/main/class.Banner.html), which is at its time the replacement for GtkInfoBar, but the api will not be the same. 4 | We will add any component, but they need to take into account this is intended to be a simple text with (maybe) some operations. 5 | " 6 | Class { 7 | #name : 'SpGtkBannerPresenter', 8 | #superclass : 'SpPresenter', 9 | #category : 'Spec-Gtk-Adapter-Window', 10 | #package : 'Spec-Gtk', 11 | #tag : 'Adapter-Window' 12 | } 13 | 14 | { #category : 'accessing' } 15 | SpGtkBannerPresenter >> add: aContentPresenter [ 16 | 17 | self layout 18 | add: aContentPresenter 19 | expand: false. 20 | aContentPresenter startTimer 21 | ] 22 | 23 | { #category : 'accessing' } 24 | SpGtkBannerPresenter >> addError: aString [ 25 | 26 | self add: ((self instantiate: SpGtkBannerContentPresenter) 27 | beError; 28 | message: aString; 29 | yourself) 30 | ] 31 | 32 | { #category : 'accessing' } 33 | SpGtkBannerPresenter >> addInfo: aString [ 34 | 35 | self add: ((self instantiate: SpGtkBannerContentPresenter) 36 | beInformation; 37 | message: aString; 38 | yourself) 39 | ] 40 | 41 | { #category : 'layout' } 42 | SpGtkBannerPresenter >> defaultLayout [ 43 | 44 | ^ SpBoxLayout newTopToBottom 45 | ] 46 | 47 | { #category : 'initialization' } 48 | SpGtkBannerPresenter >> initializePresenters [ 49 | 50 | self addStyle: 'banner' 51 | ] 52 | 53 | { #category : 'accessing' } 54 | SpGtkBannerPresenter >> remove: aContentPresenter [ 55 | 56 | self layout remove: aContentPresenter 57 | ] 58 | -------------------------------------------------------------------------------- /src/Spec-Gtk/GtkCheckBoxAdapter.class.st: -------------------------------------------------------------------------------- 1 | Class { 2 | #name : 'GtkCheckBoxAdapter', 3 | #superclass : 'GtkAdapter', 4 | #category : 'Spec-Gtk-Adapter', 5 | #package : 'Spec-Gtk', 6 | #tag : 'Adapter' 7 | } 8 | 9 | { #category : 'building' } 10 | GtkCheckBoxAdapter >> addModelTo: gtkWidget [ 11 | 12 | super addModelTo: gtkWidget. 13 | 14 | gtkWidget label: self getLabelText. 15 | gtkWidget active: self presenter state. 16 | 17 | gtkWidget connectToggled: [ 18 | self runInSystem: [ 19 | self backendUpdatingDo: [ self updatePresenterState ] ] ]. 20 | self presenter whenChangedDo: [ 21 | self withCycleDetectionOnBackendDo: [ self updateState ] ]. 22 | 23 | self presenter whenLabelChangedDo: [ self updateLabel ] 24 | ] 25 | 26 | { #category : 'emulating' } 27 | GtkCheckBoxAdapter >> clicked [ 28 | 29 | 30 | self deprecated: #Gtk4 31 | ] 32 | 33 | { #category : 'private' } 34 | GtkCheckBoxAdapter >> getLabelText [ 35 | 36 | ^ self presenter label ifNotNil: [ :aString | aString localizedForPresenter: self presenter ] 37 | ] 38 | 39 | { #category : 'accessing' } 40 | GtkCheckBoxAdapter >> state [ 41 | 42 | ^ widget isActive 43 | ] 44 | 45 | { #category : 'updating' } 46 | GtkCheckBoxAdapter >> updateLabel [ 47 | 48 | self widgetDo: [ :w | 49 | w label: self getLabelText ] 50 | ] 51 | 52 | { #category : 'updating' } 53 | GtkCheckBoxAdapter >> updatePresenterState [ 54 | 55 | self presenter state: self state 56 | ] 57 | 58 | { #category : 'updating' } 59 | GtkCheckBoxAdapter >> updateState [ 60 | 61 | self widgetDo: [ :w | 62 | self presenter state = w isActive 63 | ifFalse: [ w active: self presenter state ] ] 64 | ] 65 | 66 | { #category : 'factory' } 67 | GtkCheckBoxAdapter >> widgetClass [ 68 | 69 | ^ GtkCheckButton 70 | ] 71 | -------------------------------------------------------------------------------- /src/Spec-Gtk/GtkStatusBarAdapter.class.st: -------------------------------------------------------------------------------- 1 | Class { 2 | #name : 'GtkStatusBarAdapter', 3 | #superclass : 'GtkAdapter', 4 | #instVars : [ 5 | 'contextName' 6 | ], 7 | #category : 'Spec-Gtk-Adapter', 8 | #package : 'Spec-Gtk', 9 | #tag : 'Adapter' 10 | } 11 | 12 | { #category : 'building' } 13 | GtkStatusBarAdapter >> addModelTo: gtkStatusBar [ 14 | 15 | self model message ifNotNil: [ :message | 16 | (gtkStatusBar contextNamed: self contextName) 17 | pushMessage: message ]. 18 | 19 | unsubscribed := false. 20 | ] 21 | 22 | { #category : 'private' } 23 | GtkStatusBarAdapter >> contextName [ 24 | "Answer a the current context name." 25 | 26 | self flag: #TODO. "For now, I'm just creating an UUID string, 27 | maybe this will need to change later" 28 | ^ contextName ifNil: [ contextName := UUID new asString ] 29 | ] 30 | 31 | { #category : 'api' } 32 | GtkStatusBarAdapter >> popMessage [ 33 | 34 | unsubscribed ifTrue: [ ^ self ]. 35 | 36 | self widgetDo: [ :w | 37 | (w contextNamed: self contextName) 38 | popMessage ] 39 | ] 40 | 41 | { #category : 'api' } 42 | GtkStatusBarAdapter >> pushMessage [ 43 | 44 | unsubscribed ifTrue: [ ^ self ]. 45 | 46 | self widgetDo: [ :w | 47 | (w contextNamed: self contextName) 48 | pushMessage: self model message ] 49 | ] 50 | 51 | { #category : 'api' } 52 | GtkStatusBarAdapter >> unsubscribe [ 53 | 54 | super unsubscribe. 55 | 56 | unsubscribed := true. 57 | ] 58 | 59 | { #category : 'updating' } 60 | GtkStatusBarAdapter >> update: aSymbol [ 61 | 62 | aSymbol = #pushMessage ifTrue: [ self pushMessage ]. 63 | aSymbol = #popMessage ifTrue: [ self popMessage ]. 64 | 65 | ^ super update: aSymbol 66 | ] 67 | 68 | { #category : 'building' } 69 | GtkStatusBarAdapter >> widgetClass [ 70 | 71 | ^ GtkStatusBar 72 | ] 73 | -------------------------------------------------------------------------------- /src/Spec-Gtk-Frame/SpFramePresenter.class.st: -------------------------------------------------------------------------------- 1 | " 2 | A frame presenter to decorate a content presenter with a frame and an optional label. 3 | 4 | **IMPORTANT:** For the time being, this component is just present with the Gtk backend. 5 | " 6 | Class { 7 | #name : 'SpFramePresenter', 8 | #superclass : 'SpAbstractWidgetPresenter', 9 | #instVars : [ 10 | '#label => ObservableSlot', 11 | '#presenter => ObservableSlot' 12 | ], 13 | #category : 'Spec-Gtk-Frame-Presenter', 14 | #package : 'Spec-Gtk-Frame', 15 | #tag : 'Presenter' 16 | } 17 | 18 | { #category : 'specs' } 19 | SpFramePresenter class >> adapterName [ 20 | 21 | ^ #FrameAdapter 22 | ] 23 | 24 | { #category : 'documentation' } 25 | SpFramePresenter class >> documentExamplesProtocol [ 26 | 27 | ^ #example 28 | ] 29 | 30 | { #category : 'example' } 31 | SpFramePresenter class >> example [ 32 | 33 | ^ self new 34 | application: (SpApplication new useBackend: #Gtk); 35 | label: 'Test'; 36 | presenter: (SpLabelPresenter new 37 | label: 'Content'; 38 | yourself); 39 | open 40 | ] 41 | 42 | { #category : 'api' } 43 | SpFramePresenter >> label [ 44 | ^ label 45 | ] 46 | 47 | { #category : 'api' } 48 | SpFramePresenter >> label: anObject [ 49 | label := anObject 50 | ] 51 | 52 | { #category : 'api' } 53 | SpFramePresenter >> presenter [ 54 | 55 | ^ presenter 56 | ] 57 | 58 | { #category : 'api' } 59 | SpFramePresenter >> presenter: aPresenter [ 60 | 61 | aPresenter owner: self. 62 | presenter := aPresenter 63 | ] 64 | 65 | { #category : 'api-events' } 66 | SpFramePresenter >> whenLabelChangedDo: aBlock [ 67 | 68 | self property: #label whenChangedDo: aBlock 69 | ] 70 | 71 | { #category : 'api-events' } 72 | SpFramePresenter >> whenPresenterChangedDo: aBlock [ 73 | 74 | self property: #presenter whenChangedDo: aBlock 75 | ] 76 | -------------------------------------------------------------------------------- /src/Spec-Gtk/GtkLinkAdapter.class.st: -------------------------------------------------------------------------------- 1 | Class { 2 | #name : 'GtkLinkAdapter', 3 | #superclass : 'GtkBaseButtonAdapter', 4 | #category : 'Spec-Gtk-Adapter', 5 | #package : 'Spec-Gtk', 6 | #tag : 'Adapter' 7 | } 8 | 9 | { #category : 'building' } 10 | GtkLinkAdapter >> addModelTo: gtkButton [ 11 | 12 | super addModelTo: gtkButton. 13 | 14 | self flag: #TODO. "Add SpTAlignable to SpLinkPresenter. Now I have no time nor the requirement" 15 | gtkButton hAlignStart. 16 | gtkButton connectActivateLink: [ true ]. 17 | 18 | gtkButton connectClicked: [ 19 | self runInSystem: [ self presenter performAction ] ]. 20 | 21 | self presenter label isEmptyOrNil 22 | ifFalse: [ self updateLabelAndIconTo: gtkButton ]. 23 | 24 | model whenLabelChangedDo: [ self updateLabel ] 25 | ] 26 | 27 | { #category : 'building' } 28 | GtkLinkAdapter >> connectToSpecEvents: gtkButton [ 29 | 30 | self presenter 31 | whenLabelChangedDo: [ self updateLabel ] 32 | ] 33 | 34 | { #category : 'private - testing' } 35 | GtkLinkAdapter >> hasLabelOrIcon [ 36 | 37 | ^ self hasLabel 38 | ] 39 | 40 | { #category : 'private' } 41 | GtkLinkAdapter >> labelAndIcon [ 42 | | box gtkLabel | 43 | 44 | box := GtkBox newHorizontal 45 | hAlignCenter; 46 | spacing: 3; 47 | yourself. 48 | 49 | gtkLabel := GtkLabel new. 50 | box append: gtkLabel. 51 | 52 | ^ box 53 | ] 54 | 55 | { #category : 'building' } 56 | GtkLinkAdapter >> newWidget [ 57 | 58 | ^ GtkLinkButton newWithUri: '' 59 | ] 60 | 61 | { #category : 'private - updating' } 62 | GtkLinkAdapter >> updateLabelAndIconTo: gtkButton [ 63 | | label gtkLabel | 64 | 65 | label := self getLabelText. 66 | gtkLabel := gtkButton child children first. 67 | label isEmptyOrNil 68 | ifTrue: [ gtkLabel beNotVisible ] 69 | ifFalse: [ gtkLabel label: label; beVisible ] 70 | ] 71 | -------------------------------------------------------------------------------- /src/Spec-Gtk/SpDropListItemPresenter.class.st: -------------------------------------------------------------------------------- 1 | " 2 | A presenter to show the `SpDropListPresenter` list item. 3 | It can show an icon or not. 4 | " 5 | Class { 6 | #name : 'SpDropListItemPresenter', 7 | #superclass : 'SpPresenter', 8 | #traits : 'SpTModel', 9 | #classTraits : 'SpTModel classTrait', 10 | #instVars : [ 11 | 'iconPresenter', 12 | 'labelPresenter' 13 | ], 14 | #category : 'Spec-Gtk-Adapter-List', 15 | #package : 'Spec-Gtk', 16 | #tag : 'Adapter-List' 17 | } 18 | 19 | { #category : 'layout' } 20 | SpDropListItemPresenter >> defaultLayout [ 21 | 22 | ^ self owner hasIcons 23 | ifTrue: [ self iconLayout ] 24 | ifFalse: [ self labelLayout ] 25 | ] 26 | 27 | { #category : 'layout' } 28 | SpDropListItemPresenter >> iconLayout [ 29 | 30 | ^ SpBoxLayout newHorizontal 31 | spacing: 5; 32 | add: iconPresenter expand: false; 33 | add: labelPresenter; 34 | yourself 35 | ] 36 | 37 | { #category : 'initialization' } 38 | SpDropListItemPresenter >> initializePresenters [ 39 | 40 | iconPresenter := self newImage. 41 | labelPresenter := self newLabel 42 | ] 43 | 44 | { #category : 'layout' } 45 | SpDropListItemPresenter >> labelLayout [ 46 | 47 | ^ SpBoxLayout newHorizontal 48 | add: labelPresenter; 49 | yourself 50 | ] 51 | 52 | { #category : 'initialization' } 53 | SpDropListItemPresenter >> updatePresenter [ 54 | 55 | self model ifNil: [ ^ self ]. 56 | 57 | self owner hasIcons 58 | ifTrue: [ iconPresenter image: (self owner getIconFor: self model) ]. 59 | labelPresenter label: (self owner displayForItem: self model) 60 | ] 61 | 62 | { #category : 'layout' } 63 | SpDropListItemPresenter >> useIconLayout [ 64 | 65 | self layout: self iconLayout 66 | ] 67 | 68 | { #category : 'layout' } 69 | SpDropListItemPresenter >> useLabelLayout [ 70 | 71 | self layout: self labelLayout 72 | ] 73 | -------------------------------------------------------------------------------- /src/Spec-Gtk/GtkTreeListViewAdapterItemFactory.class.st: -------------------------------------------------------------------------------- 1 | Class { 2 | #name : 'GtkTreeListViewAdapterItemFactory', 3 | #superclass : 'GtkListViewAdapterItemFactory', 4 | #instVars : [ 5 | 'store' 6 | ], 7 | #category : 'Spec-Gtk-Adapter-ListView', 8 | #package : 'Spec-Gtk', 9 | #tag : 'Adapter-ListView' 10 | } 11 | 12 | { #category : 'accessing' } 13 | GtkTreeListViewAdapterItemFactory >> bind: listItem [ 14 | | child expander row itemReference itemStore item | 15 | 16 | expander := self objectAtHandle: listItem child. 17 | 18 | row := GtkTreeListRow fromHandleUnreferenced: listItem item getHandle. 19 | expander listRow: row. 20 | child := self presenterAtHandle: expander child getHandle. 21 | child ifNil: [ ^ self ]. 22 | 23 | itemReference := row item. 24 | itemStore := store storeAt: (itemReference dataAt: 'store'). 25 | item := itemStore itemAtHandle: itemReference getHandle. 26 | itemReference objectUnref. 27 | 28 | presenter bindAction 29 | value: child 30 | value: item 31 | ] 32 | 33 | { #category : 'accessing' } 34 | GtkTreeListViewAdapterItemFactory >> bind: listItem to: anObject [ 35 | 36 | self error: 'Should not arrive here' 37 | ] 38 | 39 | { #category : 'accessing' } 40 | GtkTreeListViewAdapterItemFactory >> setup: listItem [ 41 | | child expander | 42 | 43 | child := presenter setupAction cull: presenter. 44 | child build. 45 | 46 | self storePresenter: child. 47 | expander := GtkTreeExpander newWidget: child adapter widget. 48 | self storeObject: expander. 49 | 50 | listItem child: expander 51 | ] 52 | 53 | { #category : 'accessing' } 54 | GtkTreeListViewAdapterItemFactory >> store [ 55 | 56 | ^ store 57 | ] 58 | 59 | { #category : 'accessing' } 60 | GtkTreeListViewAdapterItemFactory >> store: aRootStore [ 61 | 62 | store := aRootStore. 63 | storedObjects removeAll 64 | ] 65 | -------------------------------------------------------------------------------- /src/Spec-Gtk-Code-Diff/GtkPatchLineVisitor.class.st: -------------------------------------------------------------------------------- 1 | Class { 2 | #name : 'GtkPatchLineVisitor', 3 | #superclass : 'DiffPatchVisitor', 4 | #instVars : [ 5 | 'lineNumber', 6 | 'textBuffer', 7 | 'lineMarks' 8 | ], 9 | #category : 'Spec-Gtk-Code-Diff', 10 | #package : 'Spec-Gtk-Code-Diff' 11 | } 12 | 13 | { #category : 'accessing' } 14 | GtkPatchLineVisitor >> addLineMark: anAssociation [ 15 | 16 | lineMarks add: anAssociation 17 | ] 18 | 19 | { #category : 'as yet unclassified' } 20 | GtkPatchLineVisitor >> incrementLineNumber [ 21 | 22 | lineNumber := lineNumber + 1 23 | ] 24 | 25 | { #category : 'initialization' } 26 | GtkPatchLineVisitor >> initialize [ 27 | 28 | super initialize. 29 | lineNumber := 0. 30 | lineMarks := OrderedCollection new 31 | ] 32 | 33 | { #category : 'accessing' } 34 | GtkPatchLineVisitor >> lineMarks [ 35 | 36 | ^ lineMarks 37 | ] 38 | 39 | { #category : 'accessing' } 40 | GtkPatchLineVisitor >> lineNumber [ 41 | 42 | ^ lineNumber 43 | ] 44 | 45 | { #category : 'accessing' } 46 | GtkPatchLineVisitor >> textBuffer [ 47 | 48 | ^ textBuffer 49 | ] 50 | 51 | { #category : 'accessing' } 52 | GtkPatchLineVisitor >> textBuffer: anObject [ 53 | 54 | textBuffer := anObject 55 | ] 56 | 57 | { #category : 'visiting' } 58 | GtkPatchLineVisitor >> visitDelete: anElement [ 59 | 60 | self incrementLineNumber. 61 | self addLineMark: lineNumber -> #delete. 62 | stream << anElement element << String cr 63 | ] 64 | 65 | { #category : 'visiting' } 66 | GtkPatchLineVisitor >> visitInsert: anElement [ 67 | 68 | self incrementLineNumber. 69 | self addLineMark: lineNumber -> #insert. 70 | stream << anElement element << String cr 71 | ] 72 | 73 | { #category : 'visiting' } 74 | GtkPatchLineVisitor >> visitMatch: anElement [ 75 | 76 | self incrementLineNumber. 77 | stream << anElement element << String cr 78 | ] 79 | -------------------------------------------------------------------------------- /src/Spec-Gtk-Pillar/GtkTextStyleTagsVisitor.class.st: -------------------------------------------------------------------------------- 1 | Class { 2 | #name : #GtkTextStyleTagsVisitor, 3 | #superclass : #SpRenderTreeVisitor, 4 | #instVars : [ 5 | 'tags', 6 | 'styleProvider', 7 | 'offset' 8 | ], 9 | #category : #'Spec-Gtk-Pillar' 10 | } 11 | 12 | { #category : #initialization } 13 | GtkTextStyleTagsVisitor >> initialize [ 14 | super initialize. 15 | tags := OrderedCollection new. 16 | offset := 1. 17 | ] 18 | 19 | { #category : #'as yet unclassified' } 20 | GtkTextStyleTagsVisitor >> styleDocument: aDocument [ 21 | self visit: aDocument. 22 | ^ tags 23 | ] 24 | 25 | { #category : #accessing } 26 | GtkTextStyleTagsVisitor >> styleProvider: aProvider [ 27 | styleProvider := aProvider 28 | ] 29 | 30 | { #category : #'as yet unclassified' } 31 | GtkTextStyleTagsVisitor >> tags [ 32 | ^ tags 33 | ] 34 | 35 | { #category : #'as yet unclassified' } 36 | GtkTextStyleTagsVisitor >> visitCompositeObject: aRenderObject [ 37 | | name offsetStart result | 38 | "(aRenderObject item isKindOf: PRAnnotatedParagraph ) ifTrue: [ self halt. ]." 39 | name := styleProvider itemNameFor: aRenderObject item. 40 | offsetStart := offset. 41 | result := super visitCompositeObject: aRenderObject. 42 | name ifNotNil: [ 43 | tags add: (GtkTextStyleTag 44 | newName: name 45 | from: offsetStart 46 | to: offset - 1).]. 47 | offset := offset + aRenderObject extraOffset 48 | ] 49 | 50 | { #category : #'as yet unclassified' } 51 | GtkTextStyleTagsVisitor >> visitText: aTextObject [ 52 | | name offsetStart | 53 | 54 | name := styleProvider itemNameFor: aTextObject item. 55 | offsetStart := offset. 56 | offset := offset + aTextObject item text size. 57 | name ifNotNil: [ 58 | tags add: (GtkTextStyleTag 59 | newName: name 60 | from: offsetStart 61 | to: offset - 1).]. 62 | offset := offset + aTextObject extraOffset. 63 | 64 | ] 65 | -------------------------------------------------------------------------------- /src/Spec-Gtk-Code-Diff/GtkPatchSideBySideVisitor.class.st: -------------------------------------------------------------------------------- 1 | Class { 2 | #name : 'GtkPatchSideBySideVisitor', 3 | #superclass : 'DiffVisitor', 4 | #instVars : [ 5 | 'leftSide', 6 | 'rightSide' 7 | ], 8 | #category : 'Spec-Gtk-Code-Diff', 9 | #package : 'Spec-Gtk-Code-Diff' 10 | } 11 | 12 | { #category : 'initialization' } 13 | GtkPatchSideBySideVisitor >> initialize [ 14 | 15 | super initialize. 16 | leftSide := OrderedCollection new. 17 | rightSide := OrderedCollection new 18 | ] 19 | 20 | { #category : 'accessing' } 21 | GtkPatchSideBySideVisitor >> leftMarks [ 22 | 23 | ^ self leftSide 24 | reject: [ :each | each first isNil ] 25 | thenCollect: [ :each | each first ] 26 | ] 27 | 28 | { #category : 'accessing' } 29 | GtkPatchSideBySideVisitor >> leftSide [ 30 | 31 | ^ leftSide 32 | ] 33 | 34 | { #category : 'accessing' } 35 | GtkPatchSideBySideVisitor >> leftText [ 36 | 37 | ^ String cr join: (self leftSide collect: #second) 38 | ] 39 | 40 | { #category : 'accessing' } 41 | GtkPatchSideBySideVisitor >> rightMarks [ 42 | 43 | ^ self rightSide 44 | reject: [ :each | each first isNil ] 45 | thenCollect: [ :each | each first ] 46 | ] 47 | 48 | { #category : 'accessing' } 49 | GtkPatchSideBySideVisitor >> rightSide [ 50 | 51 | ^ rightSide 52 | ] 53 | 54 | { #category : 'accessing' } 55 | GtkPatchSideBySideVisitor >> rightText [ 56 | 57 | ^ String cr join: (self rightSide collect: #second) 58 | ] 59 | 60 | { #category : 'visiting' } 61 | GtkPatchSideBySideVisitor >> visitDelete: anElement [ 62 | 63 | leftSide add: { ((leftSide size + 1) -> #delete). anElement element } 64 | ] 65 | 66 | { #category : 'visiting' } 67 | GtkPatchSideBySideVisitor >> visitInsert: anElement [ 68 | 69 | rightSide add: { ((rightSide size + 1) -> #insert). anElement element } 70 | ] 71 | 72 | { #category : 'visiting' } 73 | GtkPatchSideBySideVisitor >> visitMatch: anElement [ 74 | 75 | leftSide add: { nil. anElement element }. 76 | rightSide add: { nil. anElement element } 77 | ] 78 | -------------------------------------------------------------------------------- /src/Spec-Gtk/GtkTSortableColumns.trait.st: -------------------------------------------------------------------------------- 1 | " 2 | I add the ""sortable columns"" trait to adapters who can use it (tables, trees, etc.) 3 | " 4 | Trait { 5 | #name : 'GtkTSortableColumns', 6 | #instVars : [ 7 | 'currentSortingColumnIndex' 8 | ], 9 | #category : 'Spec-Gtk-Adapter-Table', 10 | #package : 'Spec-Gtk', 11 | #tag : 'Adapter-Table' 12 | } 13 | 14 | { #category : 'private' } 15 | GtkTSortableColumns >> addSortableColumnsTo: gtkTreeView [ 16 | 17 | self columns withIndexDo: [ :each :index | 18 | each isSortable ifTrue: [ 19 | self 20 | makeSortableColumn: (gtkTreeView columns at: index) 21 | model: each ] ] 22 | ] 23 | 24 | { #category : 'private accessing' } 25 | GtkTSortableColumns >> columns [ 26 | 27 | ^ self required 28 | ] 29 | 30 | { #category : 'private' } 31 | GtkTSortableColumns >> makeSortableColumn: gtkColumn model: aTableColumn [ 32 | | id | 33 | 34 | id := self columns indexOf: aTableColumn. 35 | gtkColumn 36 | beClickable; 37 | disconnect: GClickedCallback signalName; 38 | connectClicked: [ self toggleSort: gtkColumn model: aTableColumn ] 39 | ] 40 | 41 | { #category : 'private' } 42 | GtkTSortableColumns >> toggleSort: gtkColumn model: aTableColumn [ 43 | | sortFunction wasVisible columnIndex | 44 | 45 | columnIndex := self columns indexOf: aTableColumn. 46 | currentSortingColumnIndex ifNotNil: [ :index | 47 | index = columnIndex ifFalse: [ 48 | (self innerWidget columns at: index) hideSortIndicator ] ]. 49 | 50 | wasVisible := gtkColumn isSortIndicatorVisible. 51 | wasVisible ifFalse: [ gtkColumn showSortIndicator ]. 52 | 53 | sortFunction := (wasVisible not or: [ gtkColumn sortOrder == GtkSortType GTK_SORT_DESCENDING ]) 54 | ifTrue: [ 55 | gtkColumn beSortAscending. 56 | aTableColumn sortFunction ] 57 | ifFalse: [ 58 | gtkColumn beSortDescending. 59 | aTableColumn sortFunction reversed ]. 60 | 61 | currentSortingColumnIndex := columnIndex. 62 | self innerWidget model sortWith: sortFunction 63 | ] 64 | -------------------------------------------------------------------------------- /src/Spec-Gtk/GtkActionVisitor.class.st: -------------------------------------------------------------------------------- 1 | " 2 | A base visitor for actions, to use to install them as actions, shortcuts or menus 3 | " 4 | Class { 5 | #name : 'GtkActionVisitor', 6 | #superclass : 'CmVisitor', 7 | #instVars : [ 8 | 'widget', 9 | 'prefixes' 10 | ], 11 | #category : 'Spec-Gtk-Actions', 12 | #package : 'Spec-Gtk', 13 | #tag : 'Actions' 14 | } 15 | 16 | { #category : 'instance creation' } 17 | GtkActionVisitor class >> newWidget: aGtkWidget [ 18 | 19 | ^ self new 20 | widget: aGtkWidget; 21 | yourself 22 | ] 23 | 24 | { #category : 'private' } 25 | GtkActionVisitor >> actionNameFor: aCommand [ 26 | 27 | ^ '{1}.{2}' format: { self prefix. aCommand id } 28 | ] 29 | 30 | { #category : 'private' } 31 | GtkActionVisitor >> allPrefixes [ 32 | 33 | ^ prefixes 34 | ] 35 | 36 | { #category : 'initialization' } 37 | GtkActionVisitor >> initialize [ 38 | 39 | super initialize. 40 | prefixes := OrderedCollection new 41 | ] 42 | 43 | { #category : 'private' } 44 | GtkActionVisitor >> popPrefix [ 45 | 46 | prefixes removeLast 47 | ] 48 | 49 | { #category : 'private' } 50 | GtkActionVisitor >> prefix [ 51 | 52 | ^ String streamContents: [ :stream | 53 | self allPrefixes 54 | do: [ :elem | stream nextPutAll: elem asString ] 55 | separatedBy: [ stream nextPutAll: '-' ] ] 56 | ] 57 | 58 | { #category : 'private' } 59 | GtkActionVisitor >> pushPrefix: aCommandGroup [ 60 | 61 | prefixes add: aCommandGroup id 62 | ] 63 | 64 | { #category : 'private' } 65 | GtkActionVisitor >> runInSystem: aBlock [ 66 | 67 | GRunLoop enterSystem: aBlock 68 | ] 69 | 70 | { #category : 'visiting' } 71 | GtkActionVisitor >> visitCommandGroup: aCommandGroup [ 72 | 73 | self pushPrefix: aCommandGroup. 74 | [ super visitCommandGroup: aCommandGroup ] 75 | ensure: [ self popPrefix ] 76 | ] 77 | 78 | { #category : 'accessing' } 79 | GtkActionVisitor >> widget [ 80 | 81 | ^ widget 82 | ] 83 | 84 | { #category : 'accessing' } 85 | GtkActionVisitor >> widget: aGtkWidget [ 86 | 87 | widget := aGtkWidget 88 | ] 89 | -------------------------------------------------------------------------------- /src/Spec-Gtk/GtkGridAdapter.class.st: -------------------------------------------------------------------------------- 1 | Class { 2 | #name : 'GtkGridAdapter', 3 | #superclass : 'GtkLayoutAdapter', 4 | #category : 'Spec-Gtk-Layout-Grid', 5 | #package : 'Spec-Gtk', 6 | #tag : 'Layout-Grid' 7 | } 8 | 9 | { #category : 'private' } 10 | GtkGridAdapter >> addConstraints: constraints toChild: childWidget [ 11 | "adds constraits by child." 12 | 13 | (layout rowConstraintsAt: constraints row) ifNotNil: [ :c | 14 | c expand ifNotNil: [ :expand | childWidget vExpand: expand ]. 15 | self basicApplyAlignmentTo: childWidget constraints: c ]. 16 | 17 | (layout columnConstraintsAt: constraints column) ifNotNil: [ :c | 18 | c expand ifNotNil: [ :expand | childWidget hExpand: expand ]. 19 | self basicApplyAlignmentTo: childWidget constraints: c ]. 20 | 21 | self basicApplyAlignmentTo: childWidget constraints: constraints 22 | ] 23 | 24 | { #category : 'private' } 25 | GtkGridAdapter >> applyLayout: aLayout [ 26 | 27 | widget := GtkGrid new. 28 | 29 | self connectToEvents: aLayout. 30 | 31 | self widgetDo: [ :w | 32 | w 33 | margin: aLayout borderWidth; 34 | columnSpacing: aLayout columnSpacing; 35 | rowSpacing: aLayout rowSpacing; 36 | columnHomogeneous: aLayout isColumnHomogeneous; 37 | rowHomogeneous: aLayout isRowHomogeneous ] 38 | ] 39 | 40 | { #category : 'private' } 41 | GtkGridAdapter >> basicAdd: aPresenter constraints: constraints to: gtkWidget [ 42 | | childWidget | 43 | 44 | childWidget := aPresenter buildWithSelector: constraints spec. 45 | childWidget data: aPresenter. 46 | self addConstraints: constraints toChild: childWidget. 47 | gtkWidget 48 | attach: childWidget 49 | at: constraints position 50 | span: constraints span. 51 | 52 | ^ gtkWidget 53 | ] 54 | 55 | { #category : 'private' } 56 | GtkGridAdapter >> basicApplyAlignmentTo: childWidget constraints: constraints [ 57 | 58 | constraints hAlign ifNotNil: [ :hAlign | childWidget hAlign: hAlign asGtkAlign ]. 59 | constraints vAlign ifNotNil: [ :vAlign | childWidget vAlign: vAlign asGtkAlign ] 60 | ] 61 | -------------------------------------------------------------------------------- /src/Spec-Gtk-Frame/GtkFrameLayoutAdapter.class.st: -------------------------------------------------------------------------------- 1 | " 2 | Gtk adapter for the frame layout 3 | " 4 | Class { 5 | #name : 'GtkFrameLayoutAdapter', 6 | #superclass : 'GtkLayoutAdapter', 7 | #category : 'Spec-Gtk-Frame-Layout', 8 | #package : 'Spec-Gtk-Frame', 9 | #tag : 'Layout' 10 | } 11 | 12 | { #category : 'private' } 13 | GtkFrameLayoutAdapter >> addConstraits: constraints toChild: childWidget [ 14 | "adds constraits by child." 15 | 16 | ^ childWidget 17 | ] 18 | 19 | { #category : 'private' } 20 | GtkFrameLayoutAdapter >> applyLayout: aLayout [ 21 | 22 | "build of widget was differed up to here (to know what is the direction)" 23 | widget := aLayout label 24 | ifNil: [ self newFrame ] 25 | ifNotNil: [ :aLabel | self newFrameWithLabel: aLabel ]. 26 | 27 | self connectToEvents: aLayout 28 | ] 29 | 30 | { #category : 'private' } 31 | GtkFrameLayoutAdapter >> basicAdd: aPresenter constraints: constraints to: gtkWidget [ 32 | | childWidget | 33 | 34 | childWidget := aPresenter buildWithSelector: constraints spec. 35 | self addConstraits: constraints toChild: childWidget. 36 | 37 | gtkWidget child: childWidget. 38 | 39 | ^ gtkWidget 40 | ] 41 | 42 | { #category : 'testing' } 43 | GtkFrameLayoutAdapter >> childrenWidgets [ 44 | 45 | ^ self widget children 46 | ] 47 | 48 | { #category : 'factory' } 49 | GtkFrameLayoutAdapter >> newFrame [ 50 | 51 | ^ GtkFrame new 52 | ] 53 | 54 | { #category : 'factory' } 55 | GtkFrameLayoutAdapter >> newFrameWithLabel: aLabel [ 56 | 57 | ^ GtkFrame newLabel: aLabel 58 | ] 59 | 60 | { #category : 'accessing' } 61 | GtkFrameLayoutAdapter >> replace: aPresenter with: otherPresenter withConstraints: constraints [ 62 | | index | 63 | 64 | "preserve aPresenter widget (in case it will be used later)" 65 | aPresenter adapter widget 66 | objectRef; 67 | autoRelease. 68 | index := widget children indexOf: aPresenter adapter widget. 69 | self remove: aPresenter. 70 | 71 | self add: otherPresenter constraints: constraints. 72 | 73 | self innerWidgetDo: [ :w | 74 | w reorderChild: otherPresenter adapter widget position: index ] 75 | ] 76 | -------------------------------------------------------------------------------- /src/Spec-Gtk/GtkAdapterActionTextManager.class.st: -------------------------------------------------------------------------------- 1 | " 2 | A manager for texts, they have some differences with the standar manager: 3 | 4 | - there is already a context menu, the actions we define add ""extras"" to it. 5 | - the CR keybinding, if present, needs to be handled different (using the ""activate"" signal). 6 | " 7 | Class { 8 | #name : 'GtkAdapterActionTextManager', 9 | #superclass : 'GtkAdapterActionManager', 10 | #instVars : [ 11 | 'filters' 12 | ], 13 | #category : 'Spec-Gtk-Actions', 14 | #package : 'Spec-Gtk', 15 | #tag : 'Actions' 16 | } 17 | 18 | { #category : 'private' } 19 | GtkAdapterActionTextManager >> actions [ 20 | 21 | ^ self presenter actions 22 | ] 23 | 24 | { #category : 'accessing' } 25 | GtkAdapterActionTextManager >> filters [ 26 | 27 | ^ filters ifNil: [ #() ] 28 | ] 29 | 30 | { #category : 'accessing' } 31 | GtkAdapterActionTextManager >> filters: aCollection [ 32 | 33 | filters := aCollection 34 | ] 35 | 36 | { #category : 'accessing' } 37 | GtkAdapterActionTextManager >> hasContextMenu [ 38 | 39 | ^ true 40 | ] 41 | 42 | { #category : 'private - actions' } 43 | GtkAdapterActionTextManager >> installActionGroupShortcuts: anActionGroup on: gtkWidget [ 44 | 45 | GtkActionShortcutInstaller new 46 | widget: gtkWidget; 47 | filters: self filters; 48 | visit: anActionGroup 49 | ] 50 | 51 | { #category : 'private - actions' } 52 | GtkAdapterActionTextManager >> installContextMenuOn: gtkWidget [ 53 | 54 | hasContextMenu := true. 55 | gtkWidget extraMenu: (GtkActionMenuBuilder new 56 | filters: self filters; 57 | visit: self actions) 58 | ] 59 | 60 | { #category : 'actions' } 61 | GtkAdapterActionTextManager >> installGroupsOn: gtkWidget [ 62 | 63 | self presenter internalActions ifNotNil: [ :actionGroup | 64 | self installGroup: actionGroup on: gtkWidget ]. 65 | self actions ifNotNil: [ :actionGroup | 66 | self installGroup: actionGroup on: gtkWidget ] 67 | ] 68 | 69 | { #category : 'actions' } 70 | GtkAdapterActionTextManager >> showContextMenu [ 71 | 72 | self adapter innerWidgetDo: [ :w | 73 | w activateAction: 'menu.popup' ] 74 | ] 75 | -------------------------------------------------------------------------------- /src/Spec-Gtk/GtkSliderAdapter.class.st: -------------------------------------------------------------------------------- 1 | Class { 2 | #name : 'GtkSliderAdapter', 3 | #superclass : 'GtkAdapter', 4 | #category : 'Spec-Gtk-Adapter', 5 | #package : 'Spec-Gtk', 6 | #tag : 'Adapter' 7 | } 8 | 9 | { #category : 'building' } 10 | GtkSliderAdapter >> addModelTo: gtkWidget [ 11 | 12 | super addModelTo: gtkWidget. 13 | gtkWidget drawValue: false. 14 | 15 | self marks: self presenter marks into: gtkWidget. 16 | self presenter whenMarksChangedDo: [ :newValue | self updateMarks: newValue ]. 17 | 18 | gtkWidget setValue: self presenter absoluteValue. 19 | gtkWidget connectValueChanged: [ 20 | self backendUpdatingDo: [ self presenter absoluteValue: gtkWidget value ] ]. 21 | self presenter whenAbsoluteValueChangedDo: [ :newValue | 22 | self withCycleDetectionOnBackendDo: [ self updateValue: newValue ] ] 23 | ] 24 | 25 | { #category : 'building' } 26 | GtkSliderAdapter >> marks: newValue into: gtkWidget [ 27 | 28 | gtkWidget clearMarks. 29 | newValue 30 | do: [ :m | 31 | gtkWidget 32 | addMarkAtValue: (self presenter valueToAbsoluteValue: m value) 33 | withPosition: GtkPositionType GTK_POS_BOTTOM 34 | withText: m text ] 35 | ] 36 | 37 | { #category : 'building' } 38 | GtkSliderAdapter >> newWidget [ 39 | 40 | ^ self presenter isHorizontal 41 | ifTrue: [ 42 | self widgetClass 43 | newHorizontalMin: self presenter min asFloat 44 | max: self presenter max asFloat 45 | step: (self presenter quantum / self presenter max) asFloat ] 46 | ifFalse: [ 47 | self widgetClass 48 | newVerticalMin: self presenter max 49 | max: self presenter min 50 | step: (self presenter quantum / self presenter max) asFloat ] 51 | ] 52 | 53 | { #category : 'private updating' } 54 | GtkSliderAdapter >> updateMarks: newValue [ 55 | 56 | self widgetDo: [ :w | 57 | self marks: newValue into: w ] 58 | ] 59 | 60 | { #category : 'private updating' } 61 | GtkSliderAdapter >> updateValue: newValue [ 62 | 63 | self widgetDo: [ :w | 64 | w setValue: newValue asFloat ] 65 | ] 66 | 67 | { #category : 'building' } 68 | GtkSliderAdapter >> widgetClass [ 69 | 70 | ^ GtkScale 71 | ] 72 | -------------------------------------------------------------------------------- /src/Spec-Gtk/GtkRadioButtonAdapter.class.st: -------------------------------------------------------------------------------- 1 | Class { 2 | #name : 'GtkRadioButtonAdapter', 3 | #superclass : 'GtkAdapter', 4 | #category : 'Spec-Gtk-Adapter', 5 | #package : 'Spec-Gtk', 6 | #tag : 'Adapter' 7 | } 8 | 9 | { #category : 'emulating' } 10 | GtkRadioButtonAdapter >> addAssociatedTo: gtkWidget [ 11 | 12 | self presenter associatedRadioButtons ifEmpty: [ ^ self ]. 13 | 14 | self presenter associatedRadioButtons do: [ :each | 15 | each withAdapterDo: [ :anAdapter | 16 | anAdapter widgetDo: [ :w | w group: gtkWidget ] ] ]. 17 | 18 | self presenter isInitialStateSet ifFalse: [ 19 | self widgetClass new 20 | group: gtkWidget; 21 | beNotVisible; 22 | active: true ] 23 | ] 24 | 25 | { #category : 'emulating' } 26 | GtkRadioButtonAdapter >> addModelTo: gtkWidget [ 27 | 28 | super addModelTo: gtkWidget. 29 | 30 | self presenter hasLabel 31 | ifTrue: [ gtkWidget child: self newChildLabel ]. 32 | 33 | self addAssociatedTo: gtkWidget. 34 | self presenter isInitialStateSet 35 | ifTrue: [ gtkWidget active: self presenter state ]. 36 | 37 | gtkWidget connectToggled: [ self presenter state: self state ]. 38 | 39 | self model whenLabelChangedDo: [ self updateLabel ]. 40 | self model whenChangedDo: [ gtkWidget active: self presenter state ] 41 | ] 42 | 43 | { #category : 'emulating' } 44 | GtkRadioButtonAdapter >> clicked [ 45 | 46 | 47 | self deprecated: #Gtk4 48 | ] 49 | 50 | { #category : 'private' } 51 | GtkRadioButtonAdapter >> getLabelText [ 52 | 53 | ^ self presenter label ifNotNil: [ :aString | aString localizedForPresenter: self presenter ] 54 | ] 55 | 56 | { #category : 'updating' } 57 | GtkRadioButtonAdapter >> newChildLabel [ 58 | 59 | ^ ((GtkLabel newLabel: self getLabelText) 60 | wrap: true; 61 | yourself) 62 | ] 63 | 64 | { #category : 'accessing' } 65 | GtkRadioButtonAdapter >> state [ 66 | 67 | ^ widget isActive 68 | ] 69 | 70 | { #category : 'updating' } 71 | GtkRadioButtonAdapter >> updateLabel [ 72 | 73 | self widgetDo: [ :w | 74 | w child: self newChildLabel ] 75 | ] 76 | 77 | { #category : 'factory' } 78 | GtkRadioButtonAdapter >> widgetClass [ 79 | 80 | ^ GtkCheckButton 81 | ] 82 | -------------------------------------------------------------------------------- /src/Spec-Gtk-Code/GtkCodeTagTableManager.class.st: -------------------------------------------------------------------------------- 1 | " 2 | This is an util to provide the code adapter of style tables. 3 | Is for internal usage, but useful because this can change and I do not want to pollute the adapter with any future changes. 4 | " 5 | Class { 6 | #name : 'GtkCodeTagTableManager', 7 | #superclass : 'Object', 8 | #instVars : [ 9 | 'tagTables' 10 | ], 11 | #classInstVars : [ 12 | 'session' 13 | ], 14 | #category : 'Spec-Gtk-Code-Base', 15 | #package : 'Spec-Gtk-Code', 16 | #tag : 'Base' 17 | } 18 | 19 | { #category : 'instance creation' } 20 | GtkCodeTagTableManager class >> for: anApplication [ 21 | 22 | ^ anApplication 23 | propertyAt: #codeTagTableManager 24 | ifAbsentPut: [ self basicNew initialize ] 25 | ] 26 | 27 | { #category : 'instance creation' } 28 | GtkCodeTagTableManager class >> new [ 29 | 30 | self error: 'Use #for:' 31 | ] 32 | 33 | { #category : 'initialization' } 34 | GtkCodeTagTableManager >> initialize [ 35 | 36 | super initialize. 37 | tagTables := SmallDictionary new 38 | ] 39 | 40 | { #category : 'private' } 41 | GtkCodeTagTableManager >> newTagTableFor: aName [ 42 | 43 | self flag: #TODO. "highlight color in the style table? In any case, not here :P" 44 | ^ (GtkTextTagTable newForCode: (self styleTableFor: aName)) 45 | add: ((GtkTextTag newName: 'highlight') 46 | background: (Color orange alpha: 0.2); 47 | yourself); 48 | yourself 49 | ] 50 | 51 | { #category : 'private' } 52 | GtkCodeTagTableManager >> styleTableFor: aName [ 53 | 54 | ^ aName = #default 55 | ifTrue: [ SHRBTextStyler newAttributesForStyleTable: SHRBTextStyler styleTable ] 56 | ifFalse: [ SHRBTextStyler newAttributesForStyleTableNamed: aName ] 57 | ] 58 | 59 | { #category : 'private' } 60 | GtkCodeTagTableManager >> styleTableNameFor: aPresenter [ 61 | 62 | ^ aPresenter syntaxHighlightTheme 63 | ifNil: [ 64 | aPresenter application 65 | propertyAt: #syntaxHighlightTheme 66 | ifAbsent: [ #default ] ] 67 | ] 68 | 69 | { #category : 'accessing' } 70 | GtkCodeTagTableManager >> tagTableFor: aPresenter [ 71 | | styleName | 72 | 73 | styleName := self styleTableNameFor: aPresenter. 74 | ^ tagTables 75 | at: styleName 76 | ifAbsentPut: [ self newTagTableFor: styleName ] 77 | ] 78 | -------------------------------------------------------------------------------- /src/Spec-Gtk/GMenuItemActionCompound.class.st: -------------------------------------------------------------------------------- 1 | Class { 2 | #name : 'GMenuItemActionCompound', 3 | #superclass : 'Object', 4 | #instVars : [ 5 | 'presenter', 6 | 'menuItem', 7 | 'action', 8 | 'actionName' 9 | ], 10 | #category : 'Spec-Gtk-Adapter-Menu', 11 | #package : 'Spec-Gtk', 12 | #tag : 'Adapter-Menu' 13 | } 14 | 15 | { #category : 'instance creation' } 16 | GMenuItemActionCompound class >> newPresenter: aPresenter action: aName [ 17 | 18 | ^ self basicNew 19 | initializePresenter: aPresenter action: aName; 20 | yourself 21 | ] 22 | 23 | { #category : 'accessing' } 24 | GMenuItemActionCompound >> action [ 25 | 26 | ^ action 27 | ] 28 | 29 | { #category : 'accessing' } 30 | GMenuItemActionCompound >> actionName [ 31 | 32 | ^ actionName 33 | ] 34 | 35 | { #category : 'initialize' } 36 | GMenuItemActionCompound >> build [ 37 | 38 | "menu item" 39 | menuItem := GMenuItem 40 | newLabel: self presenter name 41 | action: actionName. 42 | 43 | self presenter icon 44 | ifNotNil: [ :anIcon | menuItem icon: anIcon asGdkPixbuf ]. 45 | 46 | self presenter whenNameChangedDo: [ self updateName ]. 47 | self presenter whenIconChangedDo: [ self updateIcon ]. 48 | 49 | "action" 50 | action := GSimpleAction newName: actionName. 51 | self presenter action 52 | ifNotNil: [ :aBlock | action connectActivate: aBlock ]. 53 | action enabled: self presenter isEnabled value. 54 | 55 | "submenu?" 56 | self halt 57 | ] 58 | 59 | { #category : 'initialize' } 60 | GMenuItemActionCompound >> initializePresenter: aPresenter action: aName [ 61 | 62 | presenter := aPresenter. 63 | actionName := aName. 64 | 65 | self build 66 | ] 67 | 68 | { #category : 'accessing' } 69 | GMenuItemActionCompound >> menuItem [ 70 | 71 | ^ menuItem 72 | ] 73 | 74 | { #category : 'accessing' } 75 | GMenuItemActionCompound >> presenter [ 76 | 77 | ^ presenter 78 | ] 79 | 80 | { #category : 'initialize' } 81 | GMenuItemActionCompound >> updateIcon [ 82 | 83 | GRunLoop defer: [ 84 | menuItem icon: self presenter icon asGdkPixbuf ] 85 | ] 86 | 87 | { #category : 'initialize' } 88 | GMenuItemActionCompound >> updateName [ 89 | 90 | GRunLoop defer: [ 91 | menuItem label: (self presenter name localizedForPresenter: self presenter) ] 92 | ] 93 | -------------------------------------------------------------------------------- /src/Spec-Gtk/GtkNumberInputFieldAdapter.class.st: -------------------------------------------------------------------------------- 1 | Class { 2 | #name : 'GtkNumberInputFieldAdapter', 3 | #superclass : 'GtkAbstractTextAdapter', 4 | #category : 'Spec-Gtk-Adapter', 5 | #package : 'Spec-Gtk', 6 | #tag : 'Adapter' 7 | } 8 | 9 | { #category : 'building' } 10 | GtkNumberInputFieldAdapter >> addModelTo: gtkSpinButton [ 11 | 12 | "set this first because max/min and digits set may affect the value (and super 13 | will take care of setting it)" 14 | gtkSpinButton 15 | beNumber; 16 | rangeMinimum: (self model minimum ifNil: [ Float fmin ]) 17 | maximum: (self model maximum ifNil: [ Float fmax ]). 18 | 19 | self presenter isFloat 20 | ifTrue: [ gtkSpinButton digits: (self presenter digits max: 1) ]. 21 | 22 | super addModelTo: gtkSpinButton. 23 | 24 | gtkSpinButton connectValueChanged: [ 25 | self updatePresenterText: gtkSpinButton text ]. 26 | 27 | self presenter climbRate 28 | ifNotNil: [ :rate | gtkSpinButton climbRate: rate ] 29 | ] 30 | 31 | { #category : 'building' } 32 | GtkNumberInputFieldAdapter >> newActionManager [ 33 | 34 | ^ GtkAdapterActionTextInputFieldManager on: self 35 | ] 36 | 37 | { #category : 'building' } 38 | GtkNumberInputFieldAdapter >> newWidget [ 39 | 40 | ^ self widgetClass 41 | newAdjustment: GtkAdjustment newDefault 42 | climbRate: 1.0 43 | digits: 0 44 | ] 45 | 46 | { #category : 'private' } 47 | GtkNumberInputFieldAdapter >> parseNumber: aString [ 48 | 49 | ^ (Number readFrom: aString ifFail: [ 0.0 ]) asFloat 50 | ] 51 | 52 | { #category : 'private' } 53 | GtkNumberInputFieldAdapter >> refreshText [ 54 | 55 | self widgetDo: [ :w | 56 | w value: self model number ] 57 | ] 58 | 59 | { #category : 'accessing' } 60 | GtkNumberInputFieldAdapter >> setText: aStringOrNumber to: gtkWidget [ 61 | 62 | gtkWidget value: (aStringOrNumber isString 63 | ifTrue: [ self parseNumber: aStringOrNumber ] 64 | ifFalse: [ aStringOrNumber ]) 65 | ] 66 | 67 | { #category : 'private' } 68 | GtkNumberInputFieldAdapter >> updatePresenterText: aString [ 69 | 70 | self runInSystem: [ 71 | self backendUpdatingDo: [ 72 | self presenter text: (aString copyReplaceAll: ',' with: '.') ] ] 73 | ] 74 | 75 | { #category : 'building' } 76 | GtkNumberInputFieldAdapter >> widgetClass [ 77 | 78 | ^ GtkSpinButton 79 | ] 80 | -------------------------------------------------------------------------------- /src/Spec-Gtk/GtkMenuButtonAdapter.class.st: -------------------------------------------------------------------------------- 1 | Class { 2 | #name : 'GtkMenuButtonAdapter', 3 | #superclass : 'GtkBaseButtonAdapter', 4 | #instVars : [ 5 | 'menuWidget' 6 | ], 7 | #category : 'Spec-Gtk-Adapter', 8 | #package : 'Spec-Gtk', 9 | #tag : 'Adapter' 10 | } 11 | 12 | { #category : 'building' } 13 | GtkMenuButtonAdapter >> addModelTo: gtkButton [ 14 | 15 | super addModelTo: gtkButton. 16 | 17 | self connectToSpecEvents: gtkButton. 18 | 19 | self presenter actions ifNotNil: [ :anActionGroup | 20 | self setPopoverWithActionGroup: anActionGroup to: gtkButton ]. 21 | 22 | self presenter whenActionsChangedDo: [ :anActionGroup | 23 | self widgetDo: [ :w | 24 | self setPopoverWithActionGroup: anActionGroup to: w ] ] 25 | ] 26 | 27 | { #category : 'building' } 28 | GtkMenuButtonAdapter >> buildMenu: menuPresenter [ 29 | 30 | self halt. 31 | "Use a visitor here, to 32 | a. build a menu model. 33 | b. build an action map." 34 | menuPresenter owner: self presenter. 35 | menuWidget := SpBindings 36 | value: self presenter application adapterBindings 37 | during: [ menuPresenter build ]. 38 | ^ menuWidget 39 | ] 40 | 41 | { #category : 'building' } 42 | GtkMenuButtonAdapter >> setPopoverWithActionGroup: anActionGroup to: gtkButton [ 43 | | menuModel | 44 | 45 | menuModel := GtkActionMenuBuilder new 46 | visit: anActionGroup; 47 | root. 48 | 49 | gtkButton popover: (GtkPopoverMenu newFromModelFull: menuModel) 50 | ] 51 | 52 | { #category : 'private - updating' } 53 | GtkMenuButtonAdapter >> updateLabelAndIconTo: gtkButton [ 54 | 55 | gtkButton alwaysShowArrow: false. 56 | super updateLabelAndIconTo: gtkButton 57 | ] 58 | 59 | { #category : 'updating' } 60 | GtkMenuButtonAdapter >> updateMenu [ 61 | 62 | self halt. 63 | "do: 64 | a. build menu should answer both a menuModel and an action map (do a builder for it). 65 | b. remove previous action map for the component 66 | c. install new action map (this is a deferred action, that needs to be finished on the window) 67 | " 68 | self presenter menu ifNotNil: [ :aValuable | 69 | aValuable value ifNotNil: [ :aMenu | 70 | self widgetDo: [ :w | w menuModel: (self buildMenu: aMenu) ] ] ] 71 | ] 72 | 73 | { #category : 'building' } 74 | GtkMenuButtonAdapter >> widgetClass [ 75 | 76 | ^ GtkMenuButton 77 | ] 78 | -------------------------------------------------------------------------------- /README.md: -------------------------------------------------------------------------------- 1 | # Spec-Gtk 2 | The Spec Gtk bindings for Pharo 3 | 4 | # How to install 5 | 6 | ### On Windows 7 | You need Gtk4! 8 | And you need to put it at the same place of the `Pharo.exe` executable. 9 | To simplify the process we created a VM bundled with all the DLL and resources needed to execute GTK+3 10 | 11 | You can get it from: http://files.pharo.org/vm/pharo-spur64-headless/win/latest-win64-GTK.zip 12 | 13 | NOTE: If you are running under cygwin subsystem, remember to `chmod +x *`. Libraries have to be executable! 14 | 15 | ### On macOS: 16 | 17 | You need Gtk4 (installed by brew because paths are fixed for now) 18 | ``` 19 | brew install gtk+4 20 | ``` 21 | 22 | ### On Linux 23 | You need to have Gtk4 installed (this should be already the case). 24 | You can verify with this command: 25 | ``` 26 | apt list --installed | grep gtk4 27 | ``` 28 | or 29 | ``` 30 | dnf list --installed | grep gtk4 31 | ``` 32 | You will need to remove some library files shipped with the Pharo VM: 33 | ``` 34 | rm ~/pharo/vm/lib/libfreetype.so* ~/pharo/vm/lib/libcairo*.so* 35 | ``` 36 | 37 | ## Installing in your image 38 | 39 | 1) Download a Pharo 12.0 image: 40 | 41 | ``` 42 | curl get.pharo.org/120 | bash 43 | ``` 44 | 45 | 2) Open your image using `./pharo-ui Pharo.image` and evaluate: 46 | ```Smalltalk 47 | Metacello new 48 | repository: 'github://pharo-spec/Spec-Gtk:gtk4'; 49 | baseline: 'SpecGtk'; 50 | onConflict: [ :e | e useIncoming ]; 51 | onUpgrade: [ :e | e useIncoming ]; 52 | ignoreImage; 53 | load 54 | ``` 55 | After the execution, save the image, and quit. 56 | 57 | Running GTK now requires the Pharo VM to be run in worker mode: `./pharo --worker Pharo.image`. 58 | 59 | In macOS, running the World in Morphic is not yet possible since the SDL loop will execute in the worker and assume Cocoa is in the same thread. It cannot work since Cocoa must run in the main thread. 60 | 61 | ## A first example 62 | 63 | The following code should open a small UI: 64 | 65 | ```Smalltalk 66 | SpLabelPresenter new 67 | application: (SpApplication new useBackend: #Gtk); 68 | label: 'Hello, Gtk4'; 69 | open. 70 | ``` 71 | 72 | ## Current status 73 | 74 | Currently, only the low-level infrastructure is supported. Tools building based on solely Spec2/Gtk are under way. Be patient. -------------------------------------------------------------------------------- /src/Spec-GtkBackendTests/GtkWindowAdapterTest.class.st: -------------------------------------------------------------------------------- 1 | Class { 2 | #name : 'GtkWindowAdapterTest', 3 | #superclass : 'TestCase', 4 | #instVars : [ 5 | 'app' 6 | ], 7 | #category : 'Spec-GtkBackendTests', 8 | #package : 'Spec-GtkBackendTests' 9 | } 10 | 11 | { #category : 'tests' } 12 | GtkWindowAdapterTest >> testWindowIsCorrectlyDestroyedWhenClose [ 13 | | presenter app oldWindowSize oldDisposeSize engine | 14 | 15 | engine := GEngine ensureRunning. 16 | oldWindowSize := engine windowRegistry size. 17 | oldDisposeSize := engine disposeRegistry size. 18 | 19 | app := SpApplication new useBackend: #Gtk. 20 | presenter := SpLabelPresenter newApplication: app. 21 | presenter open. 22 | 25 milliSeconds wait. 23 | presenter adapter widget autoReleaseWhenDisposedByGtk. 24 | 25 | self denyEmpty: app windows. 26 | self assert: engine windowRegistry size equals: oldWindowSize + 1. 27 | self assert: engine disposeRegistry size equals: oldDisposeSize + 1. 28 | 29 | presenter window close. 30 | presenter := nil. 31 | 32 | 3 timesRepeat: [ Smalltalk garbageCollect ]. 33 | 34 | self assertEmpty: app windows. 35 | self assert: engine windowRegistry size equals: oldWindowSize. 36 | self assert: engine disposeRegistry size equals: oldDisposeSize 37 | 38 | ] 39 | 40 | { #category : 'tests' } 41 | GtkWindowAdapterTest >> testWindowWithListViewIsCorrectlyDestroyedWhenClose [ 42 | | presenter app oldWindowSize oldDisposeSize engine | 43 | 44 | engine := GEngine ensureRunning. 45 | oldWindowSize := engine windowRegistry size. 46 | oldDisposeSize := engine disposeRegistry size. 47 | 48 | app := SpApplication new useBackend: #Gtk. 49 | presenter := SpListViewPresenter newApplication: app. 50 | presenter items: Smalltalk allClassesAndTraits. 51 | presenter open. 52 | 25 milliSeconds wait. 53 | 54 | self denyEmpty: app windows. 55 | self assert: engine windowRegistry size equals: oldWindowSize + 1. 56 | "list view is registering a factory to release when destroyed" 57 | self assert: engine disposeRegistry size equals: oldDisposeSize + 1. 58 | 59 | presenter window close. 60 | presenter := nil. 61 | 62 | 3 timesRepeat: [ Smalltalk garbageCollect ]. 63 | 64 | self assertEmpty: app windows. 65 | self assert: engine windowRegistry size equals: oldWindowSize. 66 | self assert: engine disposeRegistry size equals: oldDisposeSize 67 | 68 | ] 69 | -------------------------------------------------------------------------------- /src/Spec-Gtk/GtkMenuBuilder.class.st: -------------------------------------------------------------------------------- 1 | Class { 2 | #name : 'GtkMenuBuilder', 3 | #superclass : 'Object', 4 | #instVars : [ 5 | 'currentMenu', 6 | 'menu', 7 | 'actionNumber', 8 | 'groupName' 9 | ], 10 | #category : 'Spec-Gtk-Adapter-Menu', 11 | #package : 'Spec-Gtk', 12 | #tag : 'Adapter-Menu' 13 | } 14 | 15 | { #category : 'accessing' } 16 | GtkMenuBuilder class >> defaultGroupName [ 17 | 18 | ^ 'action' 19 | ] 20 | 21 | { #category : 'accessing' } 22 | GtkMenuBuilder >> groupName [ 23 | 24 | ^ groupName ifNil: [ groupName := self class defaultGroupName ] 25 | ] 26 | 27 | { #category : 'accessing' } 28 | GtkMenuBuilder >> groupName: aName [ 29 | 30 | groupName := aName 31 | ] 32 | 33 | { #category : 'private' } 34 | GtkMenuBuilder >> nextActionName [ 35 | 36 | ^ 'action_{1}' format: { actionNumber := actionNumber + 1 } 37 | ] 38 | 39 | { #category : 'visiting' } 40 | GtkMenuBuilder >> visitMenu: aMenuPresenter [ 41 | 42 | self 43 | withCurrentMenu: GMenu new 44 | do: [ 45 | menu ifNil: [ 46 | "first menu creates the compound" 47 | menu := GMenuCompound newMenu: currentMenu ]. 48 | aMenuPresenter groups 49 | do: [ :each | each accept: self ] ] 50 | ] 51 | 52 | { #category : 'visiting' } 53 | GtkMenuBuilder >> visitMenuGroup: aMenuGroupPresenter [ 54 | | section | 55 | 56 | section := GMenu new. 57 | currentMenu appendSection: section. 58 | self 59 | withCurrentMenu: section 60 | do: [ 61 | aMenuGroupPresenter menuItems 62 | do: [ :each | each accept: self ] ] 63 | ] 64 | 65 | { #category : 'visiting' } 66 | GtkMenuBuilder >> visitMenuItem: aMenuItemPresenter [ 67 | | action | 68 | 69 | action := (GMenuItemActionCompound 70 | newPresenter: aMenuItemPresenter 71 | action: self nextActionName). 72 | 73 | currentMenu appendItem: action menuItem. 74 | menu addAction: action. 75 | 76 | "add submenu if it there is one" 77 | aMenuItemPresenter subMenu 78 | ifNotNil: [ :aMenuPresenter | | subMenu | 79 | subMenu := GMenu new. 80 | self 81 | withCurrentMenu: subMenu 82 | do: [ aMenuPresenter accept: self ]. 83 | action menuItem subMenu: subMenu ] 84 | ] 85 | 86 | { #category : 'private' } 87 | GtkMenuBuilder >> withCurrentMenu: aMenu do: aBlock [ 88 | | oldMenu | 89 | 90 | oldMenu := currentMenu. 91 | currentMenu := aMenu. 92 | aBlock ensure: [ 93 | currentMenu := oldMenu ] 94 | 95 | ] 96 | -------------------------------------------------------------------------------- /src/Spec-Gtk-Morphic-Adapter/GtkPaginatorAdapter.class.st: -------------------------------------------------------------------------------- 1 | Class { 2 | #name : 'GtkPaginatorAdapter', 3 | #superclass : 'GtkAdapter', 4 | #category : 'Spec-Gtk-Morphic-Adapter', 5 | #package : 'Spec-Gtk-Morphic-Adapter' 6 | } 7 | 8 | { #category : 'building' } 9 | GtkPaginatorAdapter >> addModelTo: gtkWidget [ 10 | | morph | 11 | 12 | gtkWidget beMorphNotResizable. 13 | gtkWidget vExpand: false. 14 | gtkWidget marginBottom: self defaultMarginBottom. 15 | gtkWidget morph: (morph := SpPaginatorMorph new 16 | height: self defaultPaginatorHeight; 17 | addPages: self presenter pages; 18 | selectPage: self presenter pages size; 19 | color: self backgroundColor; 20 | selectionColor: self selectedColor; 21 | yourself). 22 | 23 | self presenter whenSelectedPageChangedDo: [ :aNumber | 24 | self withCycleDetectionOnBackendDo: [ 25 | morph selectPage: aNumber ] ]. 26 | morph whenSelectedPageChangedDo: [ :aNumber | 27 | self backendUpdatingDo: [ 28 | self presenter selectPage: aNumber ] ]. 29 | 30 | self presenter whenVisiblePagesChangedDo: [ :aNumber | 31 | self withCycleDetectionOnBackendDo: [ 32 | morph numberOfPagesShown: aNumber ] ]. 33 | morph whenNumberOfPagesShownChangedDo: [ :aNumber | 34 | self backendUpdatingDo: [ 35 | self presenter visiblePages: aNumber ] ]. 36 | 37 | self presenter whenPageAddedDo: [ :anObject | 38 | morph 39 | addPage: anObject; 40 | selectLastPage ]. 41 | self presenter whenPageRemovedDo: [ :anObject | 42 | anObject 43 | ifNotNil: [ morph removePage: anObject ] 44 | ifNil: [ morph removeAllPages ] ] 45 | 46 | ] 47 | 48 | { #category : 'private' } 49 | GtkPaginatorAdapter >> backgroundColor [ 50 | 51 | ^ self presenter application configuration panelBackgroundColor 52 | ] 53 | 54 | { #category : 'private' } 55 | GtkPaginatorAdapter >> defaultMarginBottom [ 56 | 57 | ^ 5 58 | ] 59 | 60 | { #category : 'private' } 61 | GtkPaginatorAdapter >> defaultPaginatorHeight [ 62 | 63 | ^ 22 64 | ] 65 | 66 | { #category : 'private' } 67 | GtkPaginatorAdapter >> panelBackgroundColor [ 68 | 69 | ^ self presenter application configuration panelBackgroundColor 70 | ] 71 | 72 | { #category : 'private' } 73 | GtkPaginatorAdapter >> selectedColor [ 74 | 75 | ^ self presenter application configuration listSelectedColor alpha: 0.3 76 | ] 77 | 78 | { #category : 'building' } 79 | GtkPaginatorAdapter >> widgetClass [ 80 | 81 | ^ GtkMorphView 82 | ] 83 | -------------------------------------------------------------------------------- /src/Spec-GtkBackendTests/GtkComponentListAdapterTest.class.st: -------------------------------------------------------------------------------- 1 | Class { 2 | #name : 'GtkComponentListAdapterTest', 3 | #superclass : 'GtkAdapterTestCase', 4 | #category : 'Spec-GtkBackendTests', 5 | #package : 'Spec-GtkBackendTests' 6 | } 7 | 8 | { #category : 'running' } 9 | GtkComponentListAdapterTest >> classToTest [ 10 | ^ SpComponentListPresenter 11 | ] 12 | 13 | { #category : 'running' } 14 | GtkComponentListAdapterTest >> testAddingOnePresentersToAlreadyOpenedWidgetAddsOneRow [ 15 | self openInstance. 16 | self assert: self adapter items size equals: 0. 17 | presenter 18 | addPresenter: 19 | (SpButtonPresenter new 20 | label: ' Test '; 21 | yourself). 22 | presenter 23 | addPresenter: 24 | (SpButtonPresenter new 25 | label: ' Test '; 26 | yourself). 27 | self assert: self adapter items size equals: 2 28 | ] 29 | 30 | { #category : 'running' } 31 | GtkComponentListAdapterTest >> testAddingTwoPresentersToAlreadyOpenedWidgetAddsOneTwo [ 32 | self openInstance. 33 | self assert: self adapter items size equals: 0. 34 | presenter 35 | addPresenter: (SpButtonPresenter new label: ' Test ' yourself). 36 | presenter 37 | addPresenter: 38 | (SpButtonPresenter new 39 | label: ' Test '; 40 | yourself). 41 | self assert: self adapter items size equals: 2 42 | ] 43 | 44 | { #category : 'running' } 45 | GtkComponentListAdapterTest >> testOpeningAComponentListPresenterWithOnePresenterGeneratesAWidgetWithOneRow [ 46 | presenter 47 | addPresenter: 48 | (SpButtonPresenter new 49 | label: ' Test '; 50 | yourself). 51 | self openInstance. 52 | self 53 | assert: self adapter widget children size 54 | equals: 1 55 | ] 56 | 57 | { #category : 'running' } 58 | GtkComponentListAdapterTest >> testOpeningAComponentListPresenterWithTwoPresenterGeneratesAWidgetWithTwoRow [ 59 | presenter 60 | addPresenter: 61 | (SpButtonPresenter new 62 | label: ' Test '; 63 | yourself); 64 | addPresenter: 65 | (SpLabelPresenter new 66 | label: 'Test2'; 67 | yourself). 68 | self openInstance. 69 | self 70 | assert: self adapter widget children size 71 | equals: 2 72 | ] 73 | 74 | { #category : 'running' } 75 | GtkComponentListAdapterTest >> testOpeningAnEmptyComponentListPresenterGeneratesAWidgetWithZeroRows [ 76 | self openInstance. 77 | self assert: self adapter items isEmpty 78 | ] 79 | 80 | { #category : 'running' } 81 | GtkComponentListAdapterTest >> testPresenterStartsWithNonePresenter [ 82 | self assert: presenter presenters isEmpty 83 | ] 84 | -------------------------------------------------------------------------------- /src/Spec-Gtk/GtkTabAdapter.class.st: -------------------------------------------------------------------------------- 1 | Class { 2 | #name : 'GtkTabAdapter', 3 | #superclass : 'GtkLayoutAdapter', 4 | #instVars : [ 5 | 'lastPage' 6 | ], 7 | #category : 'Spec-Gtk-Layout-Box', 8 | #package : 'Spec-Gtk', 9 | #tag : 'Layout-Box' 10 | } 11 | 12 | { #category : 'building' } 13 | GtkTabAdapter >> adapterWasBuilt [ 14 | 15 | layout children ifEmpty: [ ^ self ]. 16 | lastPage := layout children at: layout initialPageIndex. 17 | layout initialPageIndex = 1 ifFalse: [ 18 | self widgetDo: [ :w | 19 | w currentPage: layout initialPageIndex ] ] 20 | ] 21 | 22 | { #category : 'private' } 23 | GtkTabAdapter >> addConstraints: constraints toChild: childWidget [ 24 | "adds constraits by child." 25 | 26 | ^ childWidget 27 | ] 28 | 29 | { #category : 'private' } 30 | GtkTabAdapter >> applyLayout: aLayout [ 31 | 32 | widget := GtkNotebook new. 33 | widget beScrollable. 34 | 35 | self connectToEvents: aLayout. 36 | 37 | self flag: #WARNING. "switch page will be called a last time when releasing. 38 | I have no way to fix this in an efficient way so users need to take this 39 | into account (if they are using tab select/unselect events)" 40 | widget connectSwitchPage: [ :aPage | 41 | lastPage ifNotNil: [ 42 | aLayout announce: (SpTabUnselected newPresenter: lastPage) ]. 43 | lastPage := aPage data. 44 | aLayout announce: (SpTabSelected newPresenter: aPage data) ] 45 | ] 46 | 47 | { #category : 'private' } 48 | GtkTabAdapter >> basicAdd: aPresenter constraints: constraints to: gtkWidget [ 49 | 50 | | childWidget labelPresenter labelWidget page | 51 | labelPresenter := constraints label asPresenter. 52 | labelWidget := labelPresenter hasAdapter 53 | ifTrue: [ labelPresenter adapter widget ] 54 | ifFalse: [ 55 | labelPresenter 56 | owner: aPresenter owner; 57 | build ]. 58 | 59 | childWidget := aPresenter buildWithSelector: constraints spec. 60 | page := widget newPageLabel: labelWidget content: childWidget. 61 | page data: aPresenter. 62 | gtkWidget append: page. 63 | 64 | ^ gtkWidget 65 | ] 66 | 67 | { #category : 'removing' } 68 | GtkTabAdapter >> remove: aPresenter [ 69 | 70 | ^ self widgetDo: [ :w | 71 | | widgetToRemove | 72 | widgetToRemove := aPresenter adapter widget. 73 | self ensureRetained: widgetToRemove. 74 | w remove: (w children detect: [ :each | each data = aPresenter ]) ] 75 | ] 76 | 77 | { #category : 'accessing' } 78 | GtkTabAdapter >> selectIndex: index [ 79 | 80 | lastPage := layout children at: index. 81 | self widgetDo: [ :w | 82 | w currentPage: index - 1 ] 83 | ] 84 | -------------------------------------------------------------------------------- /src/Spec-Gtk/GtkActionMenuBuilder.class.st: -------------------------------------------------------------------------------- 1 | " 2 | creates a `GMenu` from the defined actions and groups. 3 | " 4 | Class { 5 | #name : 'GtkActionMenuBuilder', 6 | #superclass : 'GtkActionVisitor', 7 | #instVars : [ 8 | 'menu', 9 | 'root', 10 | 'filters' 11 | ], 12 | #category : 'Spec-Gtk-Actions', 13 | #package : 'Spec-Gtk', 14 | #tag : 'Actions' 15 | } 16 | 17 | { #category : 'private' } 18 | GtkActionMenuBuilder >> allPrefixes [ 19 | "| allPrefixes | 20 | 21 | allPrefixes := super allPrefixes. 22 | allPrefixes isEmptyOrNil ifTrue: [ ^ allPrefixes ]. 23 | 24 | ^ allPrefixes first 25 | ifNotNil: [ allPrefixes allButFirst ] 26 | ifNil: [ allPrefixes ]" 27 | ^ super allPrefixes 28 | ] 29 | 30 | { #category : 'visiting' } 31 | GtkActionMenuBuilder >> appendSection: aMenu label: aName to: parentMenu [ 32 | 33 | parentMenu 34 | appendLabel: nil 35 | section: menu 36 | ] 37 | 38 | { #category : 'visiting' } 39 | GtkActionMenuBuilder >> appendSubmenu: aMenu label: aName to: parentMenu [ 40 | 41 | parentMenu 42 | appendLabel: aName 43 | submenu: menu 44 | ] 45 | 46 | { #category : 'accessing' } 47 | GtkActionMenuBuilder >> filters: aCollection [ 48 | 49 | filters := aCollection 50 | ] 51 | 52 | { #category : 'initialization' } 53 | GtkActionMenuBuilder >> initialize [ 54 | 55 | super initialize. 56 | filters := #() 57 | ] 58 | 59 | { #category : 'private - testing' } 60 | GtkActionMenuBuilder >> isFiltered: aCommand [ 61 | 62 | ^ filters includes: aCommand name 63 | ] 64 | 65 | { #category : 'accessing' } 66 | GtkActionMenuBuilder >> root [ 67 | 68 | ^ root 69 | ] 70 | 71 | { #category : 'visiting' } 72 | GtkActionMenuBuilder >> visit: anObject [ 73 | 74 | root := GMenu new. 75 | super visit: anObject. 76 | ^ root 77 | ] 78 | 79 | { #category : 'visiting' } 80 | GtkActionMenuBuilder >> visitCommand: aCommand [ 81 | 82 | aCommand isVisible ifFalse: [ ^ self ]. 83 | (self isFiltered: aCommand) ifTrue: [ ^ self ]. 84 | 85 | menu 86 | appendLabel: aCommand dynamicName 87 | actionName: (self actionNameFor: aCommand) 88 | ] 89 | 90 | { #category : 'visiting' } 91 | GtkActionMenuBuilder >> visitCommandGroup: aCommandGroup [ 92 | | oldMenu | 93 | 94 | oldMenu := menu. 95 | menu := menu 96 | ifNotNil: [ GMenu new ] 97 | ifNil: [ root ]. 98 | [ 99 | super visitCommandGroup: aCommandGroup. 100 | oldMenu ifNotNil: [ 101 | aCommandGroup displayStrategy 102 | appendGroup: menu 103 | label: aCommandGroup name 104 | to: oldMenu 105 | in: self ] 106 | ] 107 | ensure: [ 108 | menu := oldMenu ] 109 | ] 110 | -------------------------------------------------------------------------------- /src/Spec-Gtk/SpGtkBannerContentPresenter.class.st: -------------------------------------------------------------------------------- 1 | " 2 | A simple content for `SpGtkBannerPresenter`. 3 | " 4 | Class { 5 | #name : 'SpGtkBannerContentPresenter', 6 | #superclass : 'SpPresenter', 7 | #instVars : [ 8 | 'messageLabel', 9 | 'closeButton', 10 | 'showTime', 11 | 'process' 12 | ], 13 | #category : 'Spec-Gtk-Adapter-Window', 14 | #package : 'Spec-Gtk', 15 | #tag : 'Adapter-Window' 16 | } 17 | 18 | { #category : 'private' } 19 | SpGtkBannerContentPresenter class >> defaultShowTime [ 20 | 21 | ^ 5 seconds 22 | ] 23 | 24 | { #category : 'accessing' } 25 | SpGtkBannerContentPresenter >> beError [ 26 | 27 | self addStyle: 'error' 28 | ] 29 | 30 | { #category : 'accessing' } 31 | SpGtkBannerContentPresenter >> beInformation [ 32 | 33 | self addStyle: 'info' 34 | ] 35 | 36 | { #category : 'accessing' } 37 | SpGtkBannerContentPresenter >> beRequest [ 38 | 39 | self addStyle: 'request' 40 | ] 41 | 42 | { #category : 'layout' } 43 | SpGtkBannerContentPresenter >> defaultLayout [ 44 | 45 | ^ SpBoxLayout newLeftToRight 46 | borderWidth: 3; 47 | add: messageLabel; 48 | add: closeButton expand: false; 49 | yourself 50 | ] 51 | 52 | { #category : 'actions' } 53 | SpGtkBannerContentPresenter >> doClose [ 54 | 55 | self owner remove: self 56 | ] 57 | 58 | { #category : 'initialization' } 59 | SpGtkBannerContentPresenter >> initializePresenters [ 60 | 61 | messageLabel := self newLabel. 62 | closeButton := self newButton 63 | addStyle: 'flat'; 64 | addStyle: 'pill'; 65 | "addStyle: 'circular';" 66 | icon: (GRunLoop defer: [ GtkImage newIconName: 'gtk-close' ]); 67 | action: [ self doClose ]; 68 | yourself 69 | ] 70 | 71 | { #category : 'accessing' } 72 | SpGtkBannerContentPresenter >> message: aString [ 73 | 74 | messageLabel label: aString 75 | ] 76 | 77 | { #category : 'private' } 78 | SpGtkBannerContentPresenter >> schedule: aTaskOrBlock [ 79 | 80 | process := aTaskOrBlock forkNamed: 'Banner' 81 | ] 82 | 83 | { #category : 'accessing' } 84 | SpGtkBannerContentPresenter >> showTime [ 85 | 86 | ^ showTime ifNil: [ self class defaultShowTime ] 87 | ] 88 | 89 | { #category : 'accessing' } 90 | SpGtkBannerContentPresenter >> showTime: aTime [ 91 | 92 | showTime := aTime 93 | ] 94 | 95 | { #category : 'accessing' } 96 | SpGtkBannerContentPresenter >> startTimer [ 97 | 98 | self schedule: [ 99 | self showTime wait. 100 | self doClose ] 101 | ] 102 | 103 | { #category : 'private' } 104 | SpGtkBannerContentPresenter >> terminateTimerProcess [ 105 | 106 | process ifNil: [ ^ self ]. 107 | 108 | process terminate. 109 | process := nil 110 | ] 111 | -------------------------------------------------------------------------------- /src/Spec-Gtk/GtkTSpecialCharacterForList.trait.st: -------------------------------------------------------------------------------- 1 | " 2 | This trait will add ""special key"" treatment for list components. 3 | List components (the `GtkBaseListViewAdapter` and `GtkBaseTreeListViewAdapter` families) will not react correctly when mapping characters like ARROW UP and ARROW DOWN (because there are already internal functions there? Don't know), and we want to be able to catch those too, as any other keybinding. 4 | 5 | " 6 | Trait { 7 | #name : 'GtkTSpecialCharacterForList', 8 | #category : 'Spec-Gtk-Actions', 9 | #package : 'Spec-Gtk', 10 | #tag : 'Actions' 11 | } 12 | 13 | { #category : 'special characters' } 14 | GtkTSpecialCharacterForList classSide >> specialCharactersForList [ 15 | 16 | ^ { 17 | KeyboardKey down. 18 | KeyboardKey up. 19 | KeyboardKey left. 20 | KeyboardKey right } 21 | ] 22 | 23 | { #category : 'private - building' } 24 | GtkTSpecialCharacterForList >> addSpecialActionsToListWidget: anAdapter [ 25 | "add special actions to a text family widget. 26 | a special action is one that has a shortcut that cannot be let pass by the widget unless 27 | explicitly defined" 28 | | specialUserActions specialInternalActions | 29 | "escape if I already have an action group for this component. 30 | this may be problematic, but for now it works" 31 | (anAdapter innerWidget hasActionGroupNamed: self specialActionsForListWidgetGroupName) 32 | ifTrue: [ ^ self ]. 33 | specialInternalActions := self specialActionsForListWidgetOn: self presenter internalActions. 34 | specialUserActions := self specialActionsForListWidgetOn: self presenter actions. 35 | (specialUserActions isEmpty and: [ specialInternalActions isEmpty ]) 36 | ifTrue: [ ^ self ]. 37 | anAdapter addActionGroup: (SpActionGroup new 38 | name: self specialActionsForListWidgetGroupName; 39 | addAll: specialInternalActions; 40 | addAll: specialUserActions; 41 | yourself) 42 | ] 43 | 44 | { #category : 'private - building' } 45 | GtkTSpecialCharacterForList >> isSpecialCharacterForListWidget: aKeyCombination [ 46 | 47 | aKeyCombination combinationsDo: [ :each | 48 | each isForPlatform ifTrue: [ 49 | (self class specialCharactersForList includes: each key) 50 | ifTrue: [ ^ true ] ] ]. 51 | 52 | ^ false 53 | ] 54 | 55 | { #category : 'private - building' } 56 | GtkTSpecialCharacterForList >> specialActionsForListWidgetGroupName [ 57 | 58 | ^ UUID new asString 59 | ] 60 | 61 | { #category : 'private - building' } 62 | GtkTSpecialCharacterForList >> specialActionsForListWidgetOn: anActionGroup [ 63 | 64 | anActionGroup ifNil: [ ^ #() ]. 65 | 66 | ^ anActionGroup allCommands select: [ :each | 67 | each hasShortcutKey 68 | and: [ self isSpecialCharacterForListWidget: each shortcutKey ] ] 69 | ] 70 | -------------------------------------------------------------------------------- /src/Spec-Gtk/GtkBaseListAdapter.class.st: -------------------------------------------------------------------------------- 1 | Class { 2 | #name : 'GtkBaseListAdapter', 3 | #superclass : 'GtkAbstractListAdapter', 4 | #traits : 'GtkTHaveWrappingScrollBars', 5 | #classTraits : 'GtkTHaveWrappingScrollBars classTrait', 6 | #category : 'Spec-Gtk-Adapter-List', 7 | #package : 'Spec-Gtk', 8 | #tag : 'Adapter-List' 9 | } 10 | 11 | { #category : 'building' } 12 | GtkBaseListAdapter >> addModelTo: gtkTreeView [ 13 | 14 | super addModelTo: gtkTreeView. 15 | gtkTreeView activateOnSingleClick: self presenter isActiveOnSingleClick. 16 | self configureDragAndDrop: gtkTreeView. 17 | self addSearchTo: gtkTreeView. 18 | self presenter contextMenu ifNotNil: [ :menu | 19 | self addMenu: menu to: gtkTreeView ] 20 | ] 21 | 22 | { #category : 'building' } 23 | GtkBaseListAdapter >> addSearchTo: gtkTreeView [ 24 | 25 | self presenter isSearchEnabled ifFalse: [ ^ self ]. 26 | 27 | gtkTreeView enableSearch: true. 28 | self presenter hasCustomSearch ifTrue: [ 29 | gtkTreeView searchFunction: [ :key :column :iter | 30 | iter store: gtkTreeView model. 31 | self presenter 32 | performSearch: (self presenter itemAt: iter toPathArray first) 33 | matching: key ] ] 34 | ] 35 | 36 | { #category : 'testing' } 37 | GtkBaseListAdapter >> columns [ 38 | 39 | ^ innerWidget columns 40 | ] 41 | 42 | { #category : 'building' } 43 | GtkBaseListAdapter >> configureDragAndDrop: gtkTreeView [ 44 | "Configure drag&drop. This is related to GtkTreeDataStore too, if you want to understand how 45 | it works you need to check for GtkTreeDataStore creation/configuration too (e.g. #newTreeStore)" 46 | 47 | self presenter dragEnabled 48 | ifTrue: [ 49 | gtkTreeView enableModelDragSourceDefault ]. 50 | self presenter dropEnabled 51 | ifTrue: [ gtkTreeView enableModelDragDestDefault ] 52 | ] 53 | 54 | { #category : 'testing' } 55 | GtkBaseListAdapter >> isNonEditableRow: aRow column: aColumn [ 56 | 57 | ^ (innerWidget columns at: aColumn) isEditable not 58 | ] 59 | 60 | { #category : 'widget API' } 61 | GtkBaseListAdapter >> refreshWidgetList [ 62 | 63 | self refreshList 64 | ] 65 | 66 | { #category : 'testing' } 67 | GtkBaseListAdapter >> selectedIndexes [ 68 | ^ innerWidget selection allSelected collect: #first as: Array 69 | ] 70 | 71 | { #category : 'testing' } 72 | GtkBaseListAdapter >> selection [ 73 | 74 | ^ innerWidget selection 75 | ] 76 | 77 | { #category : 'emulating' } 78 | GtkBaseListAdapter >> type: aString [ 79 | "this will be used to test search" 80 | | entry | 81 | 82 | GRunLoop defer: [ 83 | entry := self innerWidget searchEntry ]. 84 | entry isNull inspect 85 | ] 86 | 87 | { #category : 'testing' } 88 | GtkBaseListAdapter >> unselectAll [ 89 | 90 | innerWidget selection unselectAll 91 | ] 92 | -------------------------------------------------------------------------------- /src/Spec-Gtk/GtkTSpecialCharacterForText.trait.st: -------------------------------------------------------------------------------- 1 | " 2 | This trait will add ""special key"" treatment for text components. 3 | Text components (the `GtkAbstractTextAdapter` family) will not react correctly when mapping characters like ESC and ENTER (because there are already internal functions there? Don't know), and we want to be able to catch those too, as any other keybinding. 4 | This is useful e.g. to make texts in dialogs react to ESC (which will cancel the dialog) or to spotter commands (shift+ENTER and that). 5 | 6 | " 7 | Trait { 8 | #name : 'GtkTSpecialCharacterForText', 9 | #category : 'Spec-Gtk-Actions', 10 | #package : 'Spec-Gtk', 11 | #tag : 'Actions' 12 | } 13 | 14 | { #category : 'special characters' } 15 | GtkTSpecialCharacterForText classSide >> specialCharactersForText [ 16 | 17 | ^ { 18 | KeyboardKey escape. 19 | KeyboardKey enter. 20 | KeyboardKey down. 21 | KeyboardKey up. 22 | KeyboardKey left. 23 | KeyboardKey right. } 24 | ] 25 | 26 | { #category : 'private - building' } 27 | GtkTSpecialCharacterForText >> addSpecialActionsToTextWidget: anAdapter [ 28 | "add special actions to a text family widget. 29 | a special action is one that has a shortcut that cannot be let pass by the widget unless 30 | explicitly defined" 31 | | specialUserActions specialInternalActions | 32 | "escape if I already have an action group for this component. 33 | this may be problematic, but for now it works" 34 | (anAdapter innerWidget hasActionGroupNamed: self specialActionsForTextWidgetGroupName) 35 | ifTrue: [ ^ self ]. 36 | 37 | specialInternalActions := self specialActionsForTextWidgetOn: self presenter internalActions. 38 | specialUserActions := self specialActionsForTextWidgetOn: self presenter actions. 39 | (specialUserActions isEmpty and: [ specialInternalActions isEmpty ]) 40 | ifTrue: [ ^ self ]. 41 | 42 | anAdapter addActionGroup: (SpActionGroup new 43 | name: self specialActionsForTextWidgetGroupName; 44 | addAll: specialInternalActions; 45 | addAll: specialUserActions; 46 | yourself) 47 | ] 48 | 49 | { #category : 'private - building' } 50 | GtkTSpecialCharacterForText >> isSpecialCharacterForTextWidget: aKeyCombination [ 51 | 52 | aKeyCombination combinationsDo: [ :each | 53 | each isForPlatform ifTrue: [ 54 | (self class specialCharactersForText includes: each key) 55 | ifTrue: [ ^ true ] ] ]. 56 | 57 | ^ false 58 | ] 59 | 60 | { #category : 'private - building' } 61 | GtkTSpecialCharacterForText >> specialActionsForTextWidgetGroupName [ 62 | 63 | ^ UUID new asString 64 | ] 65 | 66 | { #category : 'private - building' } 67 | GtkTSpecialCharacterForText >> specialActionsForTextWidgetOn: anActionGroup [ 68 | 69 | anActionGroup ifNil: [ ^ #() ]. 70 | 71 | ^ anActionGroup allCommands select: [ :each | 72 | each hasShortcutKey 73 | and: [ self isSpecialCharacterForTextWidget: each shortcutKey ] ] 74 | ] 75 | -------------------------------------------------------------------------------- /src/Spec-Gtk-Code/GtkCodeSmartCharacters.class.st: -------------------------------------------------------------------------------- 1 | " 2 | A model to process smart characters in the code editor. 3 | ""Smart characters"" are the auto enclosing characters (like, it adds comments when you press "" and you have something selected). 4 | " 5 | Class { 6 | #name : 'GtkCodeSmartCharacters', 7 | #superclass : 'Object', 8 | #instVars : [ 9 | 'open', 10 | 'close' 11 | ], 12 | #classVars : [ 13 | 'AllChars', 14 | 'SmartCharsTable' 15 | ], 16 | #category : 'Spec-Gtk-Code-Base', 17 | #package : 'Spec-Gtk-Code', 18 | #tag : 'Base' 19 | } 20 | 21 | { #category : 'accessing' } 22 | GtkCodeSmartCharacters class >> allChars [ 23 | 24 | ^ AllChars ifNil: [ 25 | AllChars := self smartCharsTable flatCollect: [ :each | each pairs ] ] 26 | ] 27 | 28 | { #category : 'private' } 29 | GtkCodeSmartCharacters class >> createSmartCharsTable [ 30 | 31 | ^ { 32 | self newOpen: $( close: $). 33 | self newOpen: ${ close: $}. 34 | self newOpen: $< close: $>. 35 | self newOpen: $[ close: $]. 36 | self newEnclosing: $". 37 | self newEnclosing: $'. 38 | self newEnclosing: $|. 39 | } 40 | ] 41 | 42 | { #category : 'accessing' } 43 | GtkCodeSmartCharacters class >> findMatching: aChar [ 44 | 45 | ^ self smartCharsTable detect: [ :each | each matches: aChar ] 46 | ] 47 | 48 | { #category : 'instance creation' } 49 | GtkCodeSmartCharacters class >> newEnclosing: aChar [ 50 | 51 | ^ self newOpen: aChar close: nil 52 | ] 53 | 54 | { #category : 'instance creation' } 55 | GtkCodeSmartCharacters class >> newOpen: openChar close: closeChar [ 56 | 57 | ^ self new 58 | open: openChar close: closeChar; 59 | yourself 60 | ] 61 | 62 | { #category : 'accessing' } 63 | GtkCodeSmartCharacters class >> reset [ 64 |