Squeak-dev April 2022

squeak-dev@lists.squeakfoundation.org

29 participants
333 discussions

The Trunk: System-ct.1337.mcz
by commits＠source.squeak.org 06 Apr '22

06 Apr '22

Christoph Thiede uploaded a new version of System to project The Trunk: http://source.squeak.org/trunk/System-ct.1337.mcz ==================== Summary ==================== Name: System-ct.1337 Author: ct Time: 6 April 2022, 9:16:41.622385 pm UUID: 51362b3c-0a2d-2c4a-83e1-5909bbdb9a84 Ancestors: System-ct.1336 Adds pragma-preference lookup to Preferences. Internalizes pragma ID construction. Adds execute-around setter to Preference. (Preferences pragmaPreferenceFor: Model getter: #useColorfulWindows) preferenceValue: true during: [self inform: 'Carpe Squeak!'] =============== Diff against System-ct.1336 =============== Item was changed: ----- Method: PragmaPreference>>id (in category 'accessing') ----- id + ^ Preferences pragmaIdFor: self provider getter: getter! - ^ (self provider name, '>>', getter) asSymbol! Item was added: + ----- Method: Preference>>preferenceValue:during: (in category 'value') ----- + preferenceValue: val during: aBlock + + | oldValue | + (oldValue := self preferenceValue) = val ifTrue: [^ aBlock value]. + self preferenceValue: val. + ^ aBlock ensure: + [self preferenceValue: oldValue]! Item was added: + ----- Method: Preferences class>>pragmaIdFor:getter: (in category 'accessing') ----- + pragmaIdFor: provider getter: getter + + ^ (provider name , '>>' , getter) asSymbol! Item was added: + ----- Method: Preferences class>>pragmaPreferenceFor:getter: (in category 'accessing') ----- + pragmaPreferenceFor: provider getter: getter + + ^ self preferenceAt: (self pragmaIdFor: provider getter: getter)!

1 0

The Trunk: System-ct.1336.mcz
by commits＠source.squeak.org 06 Apr '22

06 Apr '22

Christoph Thiede uploaded a new version of System to project The Trunk: http://source.squeak.org/trunk/System-ct.1336.mcz ==================== Summary ==================== Name: System-ct.1336 Author: ct Time: 6 April 2022, 9:10:17.707385 pm UUID: 8eea4965-4852-c649-aa28-138bec7f33a7 Ancestors: System-ct.1335 Corrects examples for SystemNavigation>>browseAllExtensionMethodsOfPackage:[localTo:]. =============== Diff against System-ct.1335 =============== Item was changed: ----- Method: SystemNavigation>>browseAllExtensionMethodsOfPackage: (in category 'browse') ----- browseAllExtensionMethodsOfPackage: aPackageInfoOrName + "self default browseAllExtensionMethodsOfPackage: #Morphic" - "self default browseAllExtensionMethodsOfPackage: #Morph" | packageInfo | packageInfo := self packageInfoFor: aPackageInfoOrName. ^ self browseMessageList: [self allExtensionMethodsOfPackage: packageInfo] name: ('Extensions of package {1}' translated format: {packageInfo name})! Item was changed: ----- Method: SystemNavigation>>browseAllExtensionMethodsOfPackage:localTo: (in category 'browse') ----- browseAllExtensionMethodsOfPackage: aPackageInfoOrName localTo: aClassCategory + "self default browseAllExtensionMethodsOfPackage: #Morphic localTo: 'Morphic-Support'" - "self default browseAllExtensionMethodsOfPackage: #Morph localTo: 'Morphic-Support' " | packageInfo | packageInfo := self packageInfoFor: aPackageInfoOrName. ^ self browseMessageList: [self allExtensionMethodsOfPackage: packageInfo localTo: aClassCategory] name: ('Extensions of package {1} local to {2}' translated format: {packageInfo name. aClassCategory})!

1 0

The Trunk: Morphic-ct.1961.mcz
by commits＠source.squeak.org 06 Apr '22

06 Apr '22

Christoph Thiede uploaded a new version of Morphic to project The Trunk: http://source.squeak.org/trunk/Morphic-ct.1961.mcz ==================== Summary ==================== Name: Morphic-ct.1961 Author: ct Time: 6 April 2022, 8:16:10.262385 pm UUID: a733d275-2b98-5d4c-837c-9eb9c90912ab Ancestors: Morphic-ct.1960 Tweaks default keyboard focus in dialog windows. Makes sure that for "fill in the blank" dialogs, users can type into the text field even it is not hovered initially. For system windows, avoid focusing a locked morph and beautifies the morph search by using a chained sort function. =============== Diff against Morphic-ct.1960 =============== Item was added: + ----- Method: DialogWindow>>defaultFocusMorph (in category 'accessing') ----- + defaultFocusMorph + + (preferredPosition isMorph and: [preferredPosition wantsKeyboardFocus]) ifTrue: [^ preferredPosition]. + + ^ nil! Item was changed: ----- Method: DialogWindow>>getUserResponse (in category 'running') ----- getUserResponse | hand world | self message ifEmpty: [messageMorph delete]. "Do not waste space." self paneMorph submorphs ifEmpty: ["Do not waste space and avoid strange button-row wraps." self paneMorph delete. self buttonRowMorph wrapDirection: #none]. hand := self currentHand. world := self currentWorld. self fullBounds. self morphicLayerNumber: self class dialogLayer. self moveToPreferredPosition. self openInWorld: world. hand showTemporaryCursor: nil. "Since we are out of context, reset the cursor." hand keyboardFocus in: [:priorKeyboardFocus | hand mouseFocus in: [:priorMouseFocus | self exclusive ifTrue: [hand newMouseFocus: self]. + hand newKeyboardFocus: self defaultFocusMorph. - hand newKeyboardFocus: self. [[self isInWorld] whileTrue: [world doOneSubCycle]] ifCurtailed: [self cancelDialog]. hand newKeyboardFocus: priorKeyboardFocus. self flag: #discuss. "Since 2016 we are having this *ping pong* between (a) restoring the prior mouse focus and (b) just clearing it globally. The former solution makes more sense while the latter fixes issues with some modal dialogs. We have to investigate this further." hand releaseMouseFocus. "hand newMouseFocus: priorMouseFocus."]]. ^ result! Item was added: + ----- Method: FillInTheBlankMorph>>defaultFocusMorph (in category 'accessing') ----- + defaultFocusMorph + + ^ self textPane! Item was changed: ----- Method: SystemWindow>>defaultFocusMorph (in category 'focus') ----- defaultFocusMorph | predicate | predicate := (self hasProperty: #defaultFocusMorph) + ifFalse: [ [:morph | morph isLocked not and: [morph wantsKeyboardFocus]] ] - ifFalse: [ [:morph | morph wantsKeyboardFocus] ] ifTrue: [ | anObject | anObject := (self valueOfProperty: #defaultFocusMorph) value. anObject isMorph ifTrue: [^ anObject]. [:morph | morph knownName = anObject] ]. + - self allMorphsBreadthFirstDo: [:morph | (predicate value: morph) ifTrue: [^ morph]] + sorted: #top ascending, #left ascending. + - sorted: [:a :b | a top < b top or: [a top = b top and: [a left <= b left]]]. - ^ nil!

3 2

The Trunk: Morphic-mt.1917.mcz
by commits＠source.squeak.org 06 Apr '22

06 Apr '22

Marcel Taeumel uploaded a new version of Morphic to project The Trunk: http://source.squeak.org/trunk/Morphic-mt.1917.mcz ==================== Summary ==================== Name: Morphic-mt.1917 Author: mt Time: 1 March 2022, 5:38:45.946136 pm UUID: 7266c339-a1ef-904c-b634-0b4163950574 Ancestors: Morphic-mt.1916 Next major iteration on the FontImporterTool. Needs TrueType-mt.78 =============== Diff against Morphic-mt.1916 =============== Item was changed: + SystemOrganization addCategory: #'Morphic-Balloon'! + SystemOrganization addCategory: #'Morphic-Basic'! SystemOrganization addCategory: #'Morphic-Basic-NewCurve'! + SystemOrganization addCategory: #'Morphic-Borders'! - SystemOrganization addCategory: #'Morphic-Pluggable Widgets'! SystemOrganization addCategory: #'Morphic-Collections-Arrayed'! + SystemOrganization addCategory: #'Morphic-Demo'! + SystemOrganization addCategory: #'Morphic-Events'! - SystemOrganization addCategory: #'Morphic-Widgets'! SystemOrganization addCategory: #'Morphic-Explorer'! + SystemOrganization addCategory: #'Morphic-Kernel'! + SystemOrganization addCategory: #'Morphic-Layouts'! - SystemOrganization addCategory: #'Morphic-Borders'! - SystemOrganization addCategory: #'Morphic-Menus-DockingBar'! SystemOrganization addCategory: #'Morphic-Menus'! + SystemOrganization addCategory: #'Morphic-Menus-DockingBar'! + SystemOrganization addCategory: #'Morphic-Pluggable Widgets'! + SystemOrganization addCategory: #'Morphic-Sound-Synthesis'! SystemOrganization addCategory: #'Morphic-Support'! + SystemOrganization addCategory: #'Morphic-Text Support'! SystemOrganization addCategory: #'Morphic-TrueType'! + SystemOrganization addCategory: #'Morphic-Widgets'! - SystemOrganization addCategory: #'Morphic-Basic'! - SystemOrganization addCategory: #'Morphic-Demo'! SystemOrganization addCategory: #'Morphic-Windows'! - SystemOrganization addCategory: #'Morphic-Balloon'! - SystemOrganization addCategory: #'Morphic-Kernel'! - SystemOrganization addCategory: #'Morphic-Sound-Synthesis'! SystemOrganization addCategory: #'Morphic-Worlds'! - SystemOrganization addCategory: #'Morphic-Layouts'! - SystemOrganization addCategory: #'Morphic-Text Support'! - SystemOrganization addCategory: #'Morphic-Events'! Item was removed: - Object subclass: #FontImporterFontDescription - instanceVariableNames: 'fontname filename children parent' - classVariableNames: '' - poolDictionaries: '' - category: 'Morphic-Support'! Item was removed: - ----- Method: FontImporterFontDescription>><= (in category 'comparing') ----- - <= other - - ^ self fontname asString <= other fontname asString! Item was removed: - ----- Method: FontImporterFontDescription>>addChild: (in category 'accessing') ----- - addChild: aChild - - ^ self children add: aChild! Item was removed: - ----- Method: FontImporterFontDescription>>allFilenames (in category 'accessing') ----- - allFilenames - - ^ self filename - ifNil: [ - (self children - select: [:child | child filename notNil] - thenCollect: [:child | child filename]) - asSet asArray] - ifNotNil: [:f | {f}] ! Item was removed: - ----- Method: FontImporterFontDescription>>children (in category 'accessing') ----- - children - - ^ children ifNil: [children := OrderedCollection new].! Item was removed: - ----- Method: FontImporterFontDescription>>children: (in category 'accessing') ----- - children: anObject - - children := anObject! Item was removed: - ----- Method: FontImporterFontDescription>>filename (in category 'accessing') ----- - filename - - ^ filename! Item was removed: - ----- Method: FontImporterFontDescription>>filename: (in category 'accessing') ----- - filename: anObject - - filename := anObject! Item was removed: - ----- Method: FontImporterFontDescription>>fontname (in category 'accessing') ----- - fontname - - ^ fontname! Item was removed: - ----- Method: FontImporterFontDescription>>fontname: (in category 'accessing') ----- - fontname: anObject - - fontname := anObject! Item was removed: - ----- Method: FontImporterFontDescription>>hasChildren (in category 'testing') ----- - hasChildren - - ^ self children notNil and: [self children notEmpty]! Item was removed: - ----- Method: FontImporterFontDescription>>normalize (in category 'actions') ----- - normalize - - self children size = 1 ifTrue: [ | pseudoChild | - pseudoChild := self children removeFirst. - (self filename notNil and: [pseudoChild filename ~= self filename]) - ifTrue: [self error: 'Inconsistent state']. - self filename: pseudoChild filename]! Item was removed: - ----- Method: FontImporterFontDescription>>parent (in category 'accessing') ----- - parent - - ^ parent! Item was removed: - ----- Method: FontImporterFontDescription>>parent: (in category 'accessing') ----- - parent: anObject - - parent := anObject! Item was removed: - ----- Method: FontImporterFontDescription>>printOn: (in category 'printing') ----- - printOn: aStream - - self parent ifNotNil: [:p | aStream nextPutAll: p fontname; nextPut: $ ]. - aStream nextPutAll: self fontname. - self children notEmpty ifTrue: [aStream nextPut: $ ]. - self children - do: [:subfont | aStream nextPutAll: subfont fontname] - separatedBy: [aStream nextPut: $/]. - aStream nextPut: $ ; nextPut: $(. - self allFilenames - do: [:filename | aStream nextPutAll: filename] - separatedBy: [aStream nextPut: $,; nextPut: $ ]. - aStream nextPut: $). - ! Item was changed: Model subclass: #FontImporterTool + instanceVariableNames: 'title allFonts currentSelection currentParent selectedFont previewTextSelector customPreviewText pointSize lineSpacing editModeWidgets' + classVariableNames: 'CustomPreviewTexts' - instanceVariableNames: 'title allFonts emphasis currentSelection currentParent warningSeen' - classVariableNames: '' poolDictionaries: '' category: 'Morphic-Support'! !FontImporterTool commentStamp: 'topa 3/9/2015 18:56' prior: 0! A tool to import platform (native) fonts into the image! Item was added: + ----- Method: FontImporterTool>>aboutToStyle: (in category 'preview text - code styling') ----- + aboutToStyle: aStyler + + previewTextSelector = #codeSample ifFalse: [^ false]. + self customPreviewText ifNotEmpty: [^ false]. + + aStyler parseAMethod: true. "See Text class >> #codeSample." + ^ true! Item was added: + ----- Method: FontImporterTool>>acceptCustomPreviewText: (in category 'preview text - custom') ----- + acceptCustomPreviewText: aStringOrTextOrNil + "The user accepted (i.e. CMD+S or Return) the current input text, Now we store it in the list of custom texts so that it is retrievable via the preview button." + + customPreviewText := aStringOrTextOrNil ifNotNil: [:value | value asString]. + self changed: #customPreviewText. + + self customPreviewText ifNotEmpty: [:customText | + CustomPreviewTexts ifNil: [CustomPreviewTexts := OrderedCollection new]. + (CustomPreviewTexts includes: customText) + ifFalse:[CustomPreviewTexts add: customText] ]. + + ^ true! Item was added: + ----- Method: FontImporterTool>>adjustXHeight (in category 'edit mode - actions') ----- + adjustXHeight + + self selectedFont adjustXHeight; adjustLineGapToGlyphScale. + + self currentSelection + ttExtraScale: self selectedFont extraGlyphScale; + ttExtraGap: self selectedFont extraLineGap. + + self changed: #objectChanged with: self currentSelection. + self changed: #selectedFontTextStyle. + + self changed: #pointSizeInput. + self changed: #lineSpacingInput. + self changed: #ttExtraScaleInput. + self changed: #ttExtraGapInput.! Item was changed: + ----- Method: FontImporterTool>>allFonts (in category 'font list/tree') ----- - ----- Method: FontImporterTool>>allFonts (in category 'accessing') ----- allFonts - ^ allFonts ifNil: [ | fonts | - fonts := Dictionary new. - Cursor wait showWhile: [ - TTFileDescription fontPathsDo:[:path | - TTFileDescription fontFilesIn: path do:[:font| | fontDesc filename fname | - filename := path, FileDirectory slash, font fileName. - fname := self textForFamily: font familyName subfamily: nil. - fontDesc := fonts - at: font familyName - ifAbsentPut: (FontImporterFontDescription new fontname: fname; yourself). - font subfamilyName - ifNil: [fontDesc filename: filename] - ifNotNil: [ |subfontDesc sname | - sname := self textForFamily: font familyName subfamily: font subfamilyName. - subfontDesc := FontImporterFontDescription new fontname: sname; yourself. - subfontDesc - parent: fontDesc; - filename: filename. - fontDesc addChild: subfontDesc]]]]. - allFonts := fonts values sorted. - allFonts do: [:fontDesc | fontDesc normalize]. - allFonts]. + ^ allFonts ifNil: [Cursor wait showWhile: [allFonts := TTFontFileHandle allHandles values sorted]]! - ! Item was changed: + ----- Method: FontImporterTool>>allFonts: (in category 'font list/tree') ----- - ----- Method: FontImporterTool>>allFonts: (in category 'accessing') ----- allFonts: anObject allFonts := anObject. self changed: #allFonts.! Item was added: + ----- Method: FontImporterTool>>applyFont (in category 'actions') ----- + applyFont + + | fontSymbols fontLabels choice | + fontSymbols := self fontSymbolsToUse. + fontLabels := fontSymbols collect: [:ea | (ea findFeatures joinSeparatedBy: ' ') capitalized]. + choice := Project uiManager chooseFrom: fontLabels values: fontSymbols title: 'Apply font as...' translated. + choice ifNil: [^ self]. + self applyFontTo: choice.! Item was added: + ----- Method: FontImporterTool>>applyFontTo: (in category 'actions') ----- + applyFontTo: fontSymbol + + self currentSelection isInstalled ifFalse: [self installFont]. + + Cursor wait showWhile: [ + UserInterfaceTheme setFont: fontSymbol to: self selectedFont].! Item was added: + ----- Method: FontImporterTool>>browseFont (in category 'actions') ----- + browseFont + + self selectedFont browseAllGlyphsByCategory.! Item was removed: - ----- Method: FontImporterTool>>browseImported (in category 'actions') ----- - browseImported - - | filenames fonts ttcFonts | - fonts := self currentSelection. - filenames := fonts allFilenames. - - ttcFonts := (filenames gather: [:ea | TTFontReader parseFileNamed: ea]) - collect: [:descr | TTCFont new ttcDescription: descr; pointSize: TextStyle defaultFont pointSize; yourself]. - - ttcFonts do: [:ea | ea browseAllGlyphs; browseAllGlyphsByCategory].! Item was removed: - ----- Method: FontImporterTool>>browseLinked (in category 'actions') ----- - browseLinked - - | filenames fonts ttcFonts | - fonts := self currentSelection. - filenames := fonts allFilenames. - - ttcFonts := filenames gather: [:ea | - (TTFileDescription readFontsFrom: ea) - collect: [:descr | TTCFont new ttcDescription: descr; pointSize: TextStyle defaultFont pointSize; yourself]]. - - ttcFonts do: [:ea | ea browseAllGlyphs; browseAllGlyphsByCategory].! Item was added: + ----- Method: FontImporterTool>>browseSystemFonts (in category 'actions') ----- + browseSystemFonts + "Open a workspace that shows the current preview text with the usual system fonts so that users can compare the font they want to import." + + | sample tmp fonts sorted contents preview | + previewTextSelector = #widgetSample + ifTrue: [ sample := [:font | self widgetSampleFor: font] ] + ifFalse: [ + tmp := self previewText. + sample := [:font | tmp]]. + (TextStyler for: #Smalltalk) ifNotNil: [:stylerClass | + | styler | + styler := stylerClass new. + (self aboutToStyle: styler) + ifTrue: [sample := [:font | styler styledTextFor: tmp asText]]]. + + fonts := IdentityDictionary new. + self fontSymbolsToUse do: [:ea | + | font | + font := UserInterfaceTheme current get: ea. + (fonts at: font ifAbsentPut: [OrderedCollection new]) add: ea]. + + sorted := fonts keys sorted: [:a :b | + a familyName < b familyName or: [a familyName = b familyName and: [ + a pointSize < b pointSize or: [a pointSize = b pointSize and: [ + a emphasis < b emphasis]]]]]. + + contents := Text streamContents: [:s | + + sorted do: [:font | + preview := '{1} ({2} {3}pt)\ #{4}\\' withCRs asText format: { + font familyName asText addAttribute: (PluggableTextAttribute evalBlock: [font explore]); yourself. + font subfamilyName. + font pointSize. + (fonts at: font) joinSeparatedBy: '\ #' withCRs. }. + + preview := preview, (sample value: font). + preview := preview, String cr. "for the consistent line height at the end" + + s cr; nextPutAll: (preview asText addAttribute: (TextFontReference toFont: font); yourself); cr ]]. + + contents editWithLabel: 'Current system fonts'.! Item was changed: + ----- Method: FontImporterTool>>buildButtonBarWith: (in category 'ui - building') ----- - ----- Method: FontImporterTool>>buildButtonBarWith: (in category 'toolbuilder') ----- buildButtonBarWith: builder "Build the button bar" | panelSpec | panelSpec := builder pluggablePanelSpec new. panelSpec layout: #horizontal; children: OrderedCollection new. { + #installButtonLabel. + #installButtonHelp. + #installButtonHit. + #installButtonColor. + #installButtonEnabled. + + 'Apply...' translated. + 'Apply the current font in the system. Assure that the font is installed.' translated. + #applyFont. + nil. + nil. + + "nil. nil. nil. nil." + 'Browse' translated. + 'Browse the glyphs. Do not install the font into the image.' translated. + #browseFont. - 'Read the font data and browse the glyphs. Do not install the font into the image.' translated. - #browseImported. - 'Install' translated. - 'Include the font data in the image and provide a TextStyle for the font' translated. - #import. - 'Close' translated. nil. + nil. + + 'Explore' translated. + 'Explore the font object.' translated. + #exploreFont. + nil. + nil. + } groupsDo: [:label :help :action :buttonColor :enabled | + | spec | + action + ifNil: [ + spec := builder pluggableSpacerSpec new] + ifNotNil: [ + spec := builder pluggableButtonSpec new + model: self; + label: label; + color: buttonColor; + help: help; + action: action; + enabled: enabled; + yourself]. + panelSpec children addLast: spec ]. - #close. - } groupsDo: [:label :help :action | - | buttonSpec | - buttonSpec := builder pluggableButtonSpec new - model: self; - label: label; - help: help; - action: action; - yourself. - panelSpec children addLast: buttonSpec]. ^panelSpec! Item was changed: + ----- Method: FontImporterTool>>buildFontListWith: (in category 'ui - building') ----- - ----- Method: FontImporterTool>>buildFontListWith: (in category 'toolbuilder') ----- buildFontListWith: builder "Build the font choosers list of font names" ^ builder pluggableTreeSpec new model: self; roots: #allFonts; label: #labelOf: ; getChildren: #childrenOf: ; getSelected: #currentSelection; setSelected: #currentSelection:; setSelectedParent: #currentParent:; menu: #fontListMenu:; autoDeselect: false; yourself ! Item was added: + ----- Method: FontImporterTool>>buildFontPanelWith: (in category 'ui - building') ----- + buildFontPanelWith: builder + "Build the main panel for the currently selected font (family). Includes a list of associated file names, an interactive preview panel and the copyright." + + ^ builder pluggablePanelSpec new + children: { + builder pluggableTextSpec new + model: self; + getText: #filename; + readOnly: true; + indicateUnacceptedChanges: false; + font: self filenameFont; + help: '<- Please select a font family'; + frame: (LayoutFrame + fractions: (0@0 corner: 1@0) + offsets: (0@0 corner: 0@ self filenameHeight)); + yourself. + + (self buildPreviewPaneWith: builder) + frame: (LayoutFrame + fractions: (0@0 corner: 1@1) + offsets: (0@ self filenameHeight corner: 0@ (self copyrightHeight negated))); + yourself. + + builder pluggableTextSpec new + model: self; + getText: #copyright; + font: self copyrightFont; + readOnly: true; + indicateUnacceptedChanges: false; + frame: (LayoutFrame + fractions: (0@1 corner: 1@1) + offsets: (0 @ (self copyrightHeight negated) corner: 0 @ 0)); + yourself + + }; + yourself! Item was changed: + ----- Method: FontImporterTool>>buildPreviewPaneWith: (in category 'ui - building') ----- - ----- Method: FontImporterTool>>buildPreviewPaneWith: (in category 'toolbuilder') ----- buildPreviewPaneWith: builder + "Build the preview panel. Offer the user the change preview text through the default font, point size, extra (glyph) scale and extra (line) gap." - "Build the preview panel" ^ builder pluggablePanelSpec new " wantsResizeHandles: true;" children: { + builder pluggablePanelSpec new + children: { + builder pluggableButtonSpec new + model: self; + help: #previewTextButtonHelp; + label: #previewTextButtonLabel; + action: #offerPreviewTextMenu; + frame: (LayoutFrame fractions: (0@0 corner: 0.15@1)); + yourself. + + builder pluggableInputFieldSpec new + model: self; + help: 'Type custom preview text here...' translated; + getText: #customPreviewText; + setText: #acceptCustomPreviewText:; + editText: #editCustomPreviewText:; + plainTextOnly: true; + frame: (LayoutFrame fractions: (0.15@0 corner: 0.85@1)); + yourself. + + builder pluggableButtonSpec new + model: self; + help: 'Click to see current preview text using the system''s current fonts for comparison' translated; + label: 'Compare' translated; + action: #browseSystemFonts; + frame: (LayoutFrame fractions: (0.85@0 corner: 1@1)); + yourself }; + frame: (LayoutFrame - builder pluggableTextSpec new - model: self; - getText: #filename; - readOnly: true; - indicateUnacceptedChanges: false; - font: self filenameFont; - frame: (LayoutFrame fractions: (0@0 corner: 1@0) + offsets: (0@0 corner: 0@ self customPreviewTextHeight)); - offsets: (0@0 corner: 0@ self filenameHeight)); yourself. + - builder pluggableTextSpec new model: self; getText: #previewText; textStyle: #selectedFontTextStyle; askBeforeDiscardingEdits: false; indicateUnacceptedChanges: false; softLineWrap: false; + padding: self previewTextPadding; + stylerClass: (TextStyler for: #Smalltalk); + menu: #previewTextMenu:shifted:; + frame: (LayoutFrame - frame: (LayoutFrame fractions: (0@0 corner: 1@1) + offsets: (0 @ self customPreviewTextHeight corner: 0@ self configurationPanelHeight negated)); - offsets: (0@ self filenameHeight corner: 0@ (self copyrightHeight negated))); yourself. + builder pluggablePanelSpec new name: #configPanel; children: (Array streamContents: [:s | | n | + n := 0. + self fontConfigurationSpecs groupsDo: [:kind :get :help :label :group | | w | + kind caseOf: { + [#spacer] -> [ + w := builder pluggableSpacerSpec new fillSpaceHorizontally]. + [#button] -> [ + w := builder pluggableButtonSpec new + model: self; label: label; action: get; help: help; yourself]. + [#text] -> [ + w := builder pluggableInputFieldSpec new + model: self; getText: get; setText: get asSimpleSetter; + help: help; plainTextOnly: true; yourself]. + } otherwise: [ "Ignore" ]. + w ifNotNil: [ "Remember the group. See #toggleEditMode" + w name: (group, (n := n + 1)) asSymbol. + s nextPut: w] ]]); + layout: #horizontal; + frame: self configurationPanelFrame; + yourself. - builder pluggableTextSpec new - model: self; - getText: #copyright; - font: Preferences standardBalloonHelpFont; - readOnly: true; - indicateUnacceptedChanges: false; - frame: (LayoutFrame - fractions: (0@1 corner: 1@1) - offsets: (0 @ (self copyrightHeight negated) corner: 0 @ 0)); - yourself - }; yourself! Item was changed: + ----- Method: FontImporterTool>>buildWith: (in category 'ui - building') ----- - ----- Method: FontImporterTool>>buildWith: (in category 'toolbuilder') ----- buildWith: builder "Create the ui for the browser" "ToolBuilder open: self" + | windowSpec window | - | windowSpec | windowSpec := self buildWindowWith: builder specs: { (self fontListFrame) -> [self buildFontListWith: builder]. + (self fontPanelFrame) -> [self buildFontPanelWith: builder]. - (self previewFrame) -> [self buildPreviewPaneWith: builder]. (self buttonsFrame) -> [self buildButtonBarWith: builder]. }. + window := builder build: windowSpec. + self prepareEditMode: (builder widgetAt: #configPanel). + ^ window! - ^ builder build: windowSpec! Item was changed: + ----- Method: FontImporterTool>>buttonHeight (in category 'ui - layout') ----- - ----- Method: FontImporterTool>>buttonHeight (in category 'layout') ----- buttonHeight ^ ToolBuilder default buttonRowHeight! Item was changed: + ----- Method: FontImporterTool>>buttonsFrame (in category 'ui - layout') ----- - ----- Method: FontImporterTool>>buttonsFrame (in category 'layout') ----- buttonsFrame ^ LayoutFrame fractions: (0@1 corner: 1@1) offsets: (0@ self buttonHeight negated corner: 0@0) ! Item was changed: + ----- Method: FontImporterTool>>childrenOf: (in category 'font list/tree') ----- - ----- Method: FontImporterTool>>childrenOf: (in category 'accessing') ----- childrenOf: aFontDescription ^ aFontDescription children! Item was removed: - ----- Method: FontImporterTool>>close (in category 'actions') ----- - close - self changed: #close.! Item was added: + ----- Method: FontImporterTool>>configurationPanelFrame (in category 'ui - layout') ----- + configurationPanelFrame + + ^ LayoutFrame + fractions: (0@1 corner: 1@1) + offsets: (0 @ self configurationPanelHeight negated corner: 0@0)! Item was added: + ----- Method: FontImporterTool>>configurationPanelHeight (in category 'ui - layout') ----- + configurationPanelHeight + + ^ ToolBuilder default inputFieldHeight! Item was changed: + ----- Method: FontImporterTool>>copyright (in category 'accessing') ----- - ----- Method: FontImporterTool>>copyright (in category 'model access') ----- copyright | f | f := self selectedFont ifNil:[^ '']. ^ f isTTCFont ifTrue: [f ttcDescription copyright ifNil: ['']] ifFalse: ['']! Item was added: + ----- Method: FontImporterTool>>copyrightFont (in category 'ui - layout') ----- + copyrightFont + + ^ Preferences standardBalloonHelpFont! Item was changed: + ----- Method: FontImporterTool>>copyrightHeight (in category 'ui - layout') ----- - ----- Method: FontImporterTool>>copyrightHeight (in category 'layout') ----- copyrightHeight ^ ToolBuilder default helpFieldHeightFor: 3! Item was changed: + ----- Method: FontImporterTool>>currentParent (in category 'font list/tree') ----- - ----- Method: FontImporterTool>>currentParent (in category 'accessing') ----- currentParent ^ currentParent! Item was changed: + ----- Method: FontImporterTool>>currentParent: (in category 'font list/tree') ----- - ----- Method: FontImporterTool>>currentParent: (in category 'accessing') ----- currentParent: anObject anObject = currentParent ifTrue: [^ self]. currentParent := anObject. self changed: #currentParent. ! Item was changed: + ----- Method: FontImporterTool>>currentSelection (in category 'font list/tree') ----- - ----- Method: FontImporterTool>>currentSelection (in category 'accessing') ----- currentSelection ^ currentSelection! Item was changed: + ----- Method: FontImporterTool>>currentSelection: (in category 'font list/tree') ----- + currentSelection: fontHandleOrNil - ----- Method: FontImporterTool>>currentSelection: (in category 'accessing') ----- - currentSelection: anObject + fontHandleOrNil = currentSelection ifTrue: [^ self]. + currentSelection := fontHandleOrNil. - anObject = currentSelection ifTrue: [^ self]. - currentSelection := anObject. self changed: #currentSelection. + + fontHandleOrNil + ifNotNil: [self editModeEnabled: self currentSelection isModified]. + + self selectedFont: nil. "Refresh preview"! - " self changed: #previewText. - self changed: #selectedFontTextStyle." - self changed: #filename. - self changed: #copyright.! Item was added: + ----- Method: FontImporterTool>>customPreviewText (in category 'preview text - custom') ----- + customPreviewText + + ^ customPreviewText ifNil: ['']! Item was added: + ----- Method: FontImporterTool>>customPreviewTextFont (in category 'ui - layout') ----- + customPreviewTextFont + + ^ TextStyle defaultFont! Item was added: + ----- Method: FontImporterTool>>customPreviewTextHeight (in category 'ui - layout') ----- + customPreviewTextHeight + + ^ ToolBuilder default inputFieldHeight! Item was added: + ----- Method: FontImporterTool>>defaultButtonColor (in category 'ui - colors') ----- + defaultButtonColor + + ^ (UserInterfaceTheme current get: #color for: #PluggableButtonMorph) ifNil: [Color gray: 0.91]! Item was removed: - ----- Method: FontImporterTool>>delete (in category 'actions') ----- - delete - - | font | - (font := self selectedFont) textStyleOrNil ifNotNil: [:style | - TextConstants removeKey: font familyName]. - TTCFont registerAll. - TTFontDescription removeDescriptionNamed: font familyName. - self allFonts: nil. "force redraw"! Item was added: + ----- Method: FontImporterTool>>discardCustomPreviewTexts (in category 'preview text - custom') ----- + discardCustomPreviewTexts + + CustomPreviewTexts := nil. + self setCustomPreviewText: nil.! Item was added: + ----- Method: FontImporterTool>>editButtonHelp (in category 'edit mode - ui') ----- + editButtonHelp + + ^ 'Modify font properties such as extra glyph scale and extra line gap, which will be shared through all point sizes and text styles. Be careful.' translated asTextFromHtml! Item was added: + ----- Method: FontImporterTool>>editCustomPreviewText: (in category 'preview text - custom') ----- + editCustomPreviewText: aStringOrTextOrNil + "The user typed something. Use it directly as a new preview text. Note that CMD+S (or Return) means that the user wants to save the text for later." + + customPreviewText := aStringOrTextOrNil ifNotNil: [:value | value asString]. + self changed: #previewText. + self changed: #previewTextButtonLabel.! Item was added: + ----- Method: FontImporterTool>>editModeEnabled (in category 'edit mode') ----- + editModeEnabled + + ^ Project current isMorphic + ifFalse: [false] + ifTrue: [(editModeWidgets at: #on) first visible]! Item was added: + ----- Method: FontImporterTool>>editModeEnabled: (in category 'edit mode') ----- + editModeEnabled: showEditWidgets + + Project current isMorphic ifFalse: [^ self]. + + showEditWidgets + ifFalse: [ + (editModeWidgets at: #on) do: [:ea | ea hide; disableLayout: true]. + (editModeWidgets at: #off) do: [:ea | ea show; disableLayout: false]] + ifTrue: [ + (editModeWidgets at: #on) do: [:ea | ea show; disableLayout: false]. + (editModeWidgets at: #off) do: [:ea | ea hide; disableLayout: true]].! Item was added: + ----- Method: FontImporterTool>>exploreFont (in category 'actions') ----- + exploreFont + + self selectedFont explore.! Item was removed: - ----- Method: FontImporterTool>>exploreImported (in category 'actions') ----- - exploreImported - - | filenames fonts ttcFonts | - fonts := self currentSelection. - filenames := fonts allFilenames. - - ttcFonts := (filenames gather: [:ea | TTFontReader parseFileNamed: ea]) - collect: [:descr | TTCFont new ttcDescription: descr; pointSize: TextStyle defaultFont pointSize; yourself]. - - ttcFonts do: [:ea | ea explore].! Item was removed: - ----- Method: FontImporterTool>>exploreLinked (in category 'actions') ----- - exploreLinked - - | filenames fonts ttcFonts | - fonts := self currentSelection. - filenames := fonts allFilenames. - - ttcFonts := filenames gather: [:ea | - (TTFileDescription readFontsFrom: ea) - collect: [:descr | TTCFont new ttcDescription: descr; pointSize: TextStyle defaultFont pointSize; yourself]]. - - ttcFonts do: [:ea | ea explore].! Item was changed: + ----- Method: FontImporterTool>>filename (in category 'accessing') ----- - ----- Method: FontImporterTool>>filename (in category 'model access') ----- filename ^ self currentSelection ifNil: [''] ifNotNil: [:sel | String streamContents: [:stream | + (sel allFilenames ifEmpty: [{'(unknown file location; image only)' translated}]) - sel allFilenames do: [:filename | stream nextPutAll: filename] separatedBy: [stream cr ]]]! Item was changed: + ----- Method: FontImporterTool>>filenameFont (in category 'ui - layout') ----- - ----- Method: FontImporterTool>>filenameFont (in category 'toolbuilder') ----- filenameFont + + ^ Preferences standardBalloonHelpFont! - ^ Preferences standardDefaultTextFont! Item was changed: + ----- Method: FontImporterTool>>filenameHeight (in category 'ui - layout') ----- - ----- Method: FontImporterTool>>filenameHeight (in category 'layout') ----- filenameHeight + ^ ToolBuilder default helpFieldHeightFor: 2 "lines"! - ^ ToolBuilder default inputFieldHeightFor: 3 "lines"! Item was removed: - ----- Method: FontImporterTool>>font:hasGlyphOf: (in category 'helper') ----- - font: f hasGlyphOf: aCharacter - - | font | - font := f isFontSet ifTrue: [f fontArray first] ifFalse: [f]. - ^ font hasGlyphOf: aCharacter! Item was added: + ----- Method: FontImporterTool>>fontConfigurationSpecs (in category 'ui - building') ----- + fontConfigurationSpecs + + ^ #( + text pointSizeInput pointSizeInputHelp nil preview + text lineSpacingInput lineSpacingInputHelp nil preview + spacer nil nil nil preview + button adjustXHeight 'Adjust the font''s x-height to match the system''s default font.' 'Adjust x' edit + text ttExtraScaleInput ttExtraScaleInputHelp nil edit + text ttExtraGapInput ttExtraGapInputHelp nil edit + button resetFontMetrics 'Reset all fields to their default value. Disable the edit mode.' 'Reset' edit + button toggleEditMode editButtonHelp 'Edit' toggle + )! Item was removed: - ----- Method: FontImporterTool>>fontFromFamily: (in category 'helper') ----- - fontFromFamily: aFamily - - | readFonts | - aFamily ifNil: [^ TextStyle defaultFont]. - readFonts := TTFileDescription readFontsFrom: aFamily allFilenames anyOne. - ^ (readFonts size > 1 - ifTrue: [ - | ftArray | - " see TTCFontSet>>newTextStyleFromTT: " - ftArray := readFonts collect: [:ttc | |f| - ttc ifNil: [nil] ifNotNil: [ - f := TTCFont new. - f ttcDescription: ttc. - f pointSize: TextStyle defaultFont pointSize. - f]]. - TTCFontSet newFontArray: ftArray] - ifFalse: [ |f| - f := TTCFont new. - f ttcDescription: readFonts anyOne. - f pointSize: TextStyle defaultFont pointSize. - f])! Item was changed: + ----- Method: FontImporterTool>>fontListFrame (in category 'ui - layout') ----- - ----- Method: FontImporterTool>>fontListFrame (in category 'layout') ----- fontListFrame ^ LayoutFrame + fractions: (0@0 corner: 0.25@1) - fractions: (0@0 corner: 0.4@1) offsets: (0@0 corner: 0@ self buttonHeight negated)! Item was changed: + ----- Method: FontImporterTool>>fontListMenu: (in category 'font list/tree') ----- - ----- Method: FontImporterTool>>fontListMenu: (in category 'font list') ----- fontListMenu: aMenu ^ aMenu addTranslatedList: #( + ('Browse' browseFont 'Browse all glyphs in the font') + ('Explore' exploreFont 'Explore the font object') - ('Browse Font (imported)' browseImported 'Import and browse all available glyphs') - ('Browse Font (linked)' browseLinked 'Browse all available glyphs') - + ('Install' installFont 'Make the font available in the environment but keep the glyph data outside the image') + ('Install & Load' installAndLoadFont 'Make the font available in the environment including all the glyph data to ensure portability of the image') - ('Explore Font (imported)' exploreImported 'Import and explore the font object') - ('Explore Font (linked)' exploreLinked 'Explore the font object') - - - ('Install Font (imported)' import 'Include the font data in the image and provide a TextStyle for the font') - ('Install Font (linked)' link 'Install the font as a link to its file and provide a TextStyle for the referenced font') ), (self selectedFont textStyleOrNil ifNil: [#()] ifNotNil: [#( - + ('Uninstall' uninstallFont 'Remove the font from the system') - ('Delete Font' delete 'Remove imported font data or link to font from the system') )]) yourself! Item was added: + ----- Method: FontImporterTool>>fontPanelFrame (in category 'ui - layout') ----- + fontPanelFrame + + ^ LayoutFrame + fractions: (0.25@0 corner: 1@1) + offsets: (0@0 corner: 0@ self buttonHeight negated)! Item was added: + ----- Method: FontImporterTool>>fontSymbolsToUse (in category 'accessing') ----- + fontSymbolsToUse + + ^ UserInterfaceTheme knownFontSymbols reject: [:ea | ea beginsWith: #wizard]! Item was removed: - ----- Method: FontImporterTool>>import (in category 'actions') ----- - import - | megaSize filenames fonts | - fonts := self currentSelection. - filenames := fonts allFilenames. - megaSize := ((filenames inject: 0 into: [ :sum :fn | - sum + (FileStream readOnlyFileNamed: fn do: [:file | file size])]) / (1024 * 1024)) asFloat. - (UIManager default confirm: ( - 'About to import {1}{2}.\\This is at least {3} MB of space required in the image.\ - Please respect the copyright and embedding restrictions of the font.\ - Proceed?' - translated withCRs format: { - self currentParent - ifNotNil: [:p| p fontname, ' ', self currentSelection fontname] - ifNil: [self currentSelection fontname]. - filenames size > 1 ifTrue: [' ({1} font files)' translated format: {filenames size}] ifFalse: ['']. - megaSize printShowingDecimalPlaces: 2})) - ifTrue: [ - filenames do: [:filename | | readFonts | - readFonts := TTFontDescription addFromTTFile: filename. - readFonts isCollection - ifFalse: [TTCFont newTextStyleFromTT: readFonts] - ifTrue: [self importFontFamily: readFonts]]]. - self allFonts: nil. "force redraw" - TTCFont registerAll.! Item was removed: - ----- Method: FontImporterTool>>importFontFamily: (in category 'helper') ----- - importFontFamily: readFonts - - |r rest array | - r := readFonts detect: [:f | - [f isRegular] on: Error do: [false] "hack for unknown emphases" - ] ifNone: [^ TTCFont newTextStyleFromTT: readFonts first]. - rest := readFonts copyWithout: r. - array :=TTCFont pointSizes collect: [:pt | | f | - f := TTCFont new ttcDescription: r; pointSize: pt; yourself. - rest do: [:rf | - (self isStyleNameSupported: rf subfamilyName) - ifTrue: [f derivativeFont: (TTCFont new ttcDescription: rf; pointSize: pt; yourself)] - ifFalse: [ - Transcript show: 'Cannot import unknown style ', rf subfamilyName, ' from Font family ', f name]]. - f]. - ^ TTCFont reorganizeForNewFontArray: array name: array first name asSymbol.! Item was changed: ----- Method: FontImporterTool>>initialExtent (in category 'initialize') ----- initialExtent + ^ 670@500! - ^ 600@400.! Item was changed: ----- Method: FontImporterTool>>initialize (in category 'initialize') ----- initialize super initialize. + + previewTextSelector := #textSample.! - emphasis := 0. - ! Item was added: + ----- Method: FontImporterTool>>installAndLoadFont (in category 'actions') ----- + installAndLoadFont + + self installFont ifTrue: [ + self selectedFont becomeLocalFont. + self currentSelection parent ifNotNil: [:p | self currentSelection: p]. + self changed: #objectChanged with: self currentSelection]. + + self flag: #todo. "mt: Warn the user about space constraints!!"! Item was added: + ----- Method: FontImporterTool>>installButtonColor (in category 'ui - installation') ----- + installButtonColor + + self currentSelection ifNil: [^ self defaultButtonColor]. + + ^ self currentSelection isFullyInstalled + ifTrue: [self uninstallColor] + ifFalse: [self installColor]! Item was added: + ----- Method: FontImporterTool>>installButtonEnabled (in category 'ui - installation') ----- + installButtonEnabled + + ^ self currentSelection + ifNil: [false] + ifNotNil: [:handle | handle isProtected not]! Item was added: + ----- Method: FontImporterTool>>installButtonHelp (in category 'ui - installation') ----- + installButtonHelp + + self currentSelection ifNil: [^ '']. + + ^ self currentSelection isInstalled + ifTrue: ['Remove all font data from the image. Note that existing texts or text styles may still refer to it for a while longer.' translated] + ifFalse: ['Include the font data in the image and provide a TextStyle for the font' translated].! Item was added: + ----- Method: FontImporterTool>>installButtonHit (in category 'ui - installation') ----- + installButtonHit + + self currentSelection ifNil: [^ self]. + + self currentSelection isFullyInstalled + ifTrue: [self uninstallFont] + ifFalse: [self installFont]. + + self changed: #installButtonLabel. + self changed: #installButtonColor.! Item was added: + ----- Method: FontImporterTool>>installButtonLabel (in category 'ui - installation') ----- + installButtonLabel + + self currentSelection ifNil: [^ 'Install' translated]. + + ^ self currentSelection isFullyInstalled + ifTrue: ['Uninstall' translated] + ifFalse: [ + self currentSelection isInstalled + ifTrue: ['Update' translated] + ifFalse: ['Install' translated] ]! Item was added: + ----- Method: FontImporterTool>>installColor (in category 'ui - colors') ----- + installColor + + ^ (UserInterfaceTheme current get: #okColor for: #ListChooser) ifNil: [Color r: 0.49 g: 0.749 b: 0.49]! Item was added: + ----- Method: FontImporterTool>>installFont (in category 'actions') ----- + installFont + "Install the selected font. Inform tha user that a modification is best reflected with a custom font name so that it is possible to also install the font with its original parameters." + + | handle wasRenamed | + handle := self currentSelection. + wasRenamed := false. + + (handle isModified and: [handle hasModifiedName not]) ifTrue: [ + (Project uiManager + request: 'You modified the selected font.\Please choose a new name:' translated withCRs + initialAnswer: 'My ', handle familyName) + ifEmpty: [^ false] + ifNotEmpty: [:answer | + wasRenamed := true. + handle fontname: answer]]. + + self currentSelection installFont. + self selectedFont: nil. "New identity from the handle" + + wasRenamed ifTrue: [ + "New child in the tree. So refresh everything." + allFonts := nil. self changed: #allFonts. ^ true]. + + self currentSelection parent ifNotNil: [:p | self currentSelection: p]. + self changed: #objectChanged with: self currentSelection. + + ^ true! Item was removed: - ----- Method: FontImporterTool>>isStyleNameSupported: (in category 'helper') ----- - isStyleNameSupported: subfamilyName - - ^ (TextStyle decodeStyleName: subfamilyName) second isEmpty! Item was changed: + ----- Method: FontImporterTool>>labelOf: (in category 'font list/tree') ----- + labelOf: aHandle - ----- Method: FontImporterTool>>labelOf: (in category 'model access') ----- - labelOf: aFontDescription + | label numSubfamilies| + self flag: #performance. "mt: Cache labels?" + + label := aHandle fontname. + + aHandle isLocalFont ifTrue: [label := '[', label, ']']. + (aHandle hasChildren and: [(numSubfamilies := aHandle children size) > 1]) + ifTrue: [label := label, ' (', numSubfamilies, ')']. + aHandle isModified ifTrue: [label := label, ' *']. + label := label asText. + aHandle isFullyInstalled + ifTrue: [label addAttribute: TextEmphasis underlined] + ifFalse: [aHandle isInstalled ifTrue: [ + label := '!! ' asText, label ]]. + aHandle isSubfamilySupported + ifFalse: [label addAttribute: TextColor gray]. + ^ label! - ^ aFontDescription fontname - - ! Item was added: + ----- Method: FontImporterTool>>lineSpacing (in category 'preview text - ui') ----- + lineSpacing + + ^ lineSpacing ifNil: [0.0]! Item was added: + ----- Method: FontImporterTool>>lineSpacingInput (in category 'preview text - ui') ----- + lineSpacingInput + "Redirect through #selectedFontTextStyle to get automatic suggestions e.g., for symbol fonts." + + ^ (lineSpacing ifNil: [self selectedFontTextStyle lineSpacing]) asString! Item was added: + ----- Method: FontImporterTool>>lineSpacingInput: (in category 'preview text - ui') ----- + lineSpacingInput: anObject + + self currentSelection ifNil: [^ false]. + + lineSpacing := [anObject asNumber] on: NumberParserError do: [nil]. + self changed: #lineSpacingInput. + self changed: #selectedFontTextStyle. + + ^ true! Item was added: + ----- Method: FontImporterTool>>lineSpacingInputHelp (in category 'preview text - ui') ----- + lineSpacingInputHelp + + self editModeEnabled ifFalse: [ + ^ 'Line spacing in the preview box' translated]. + + ^ 'Line spacing in the preview box. A factor of 0.0 means no extra spacing while 1.0 means to double the current line height, which is based on the fonts within each line. The value may be negative. Note that line spacing is application-specific and can thus be different for any text style (or text field). You can tweak the font itself through extra line gap to affect all its uses. Make empty to reset to default value.' translated asTextFromHtml! Item was removed: - ----- Method: FontImporterTool>>link (in category 'actions') ----- - link - | filenames fonts | - fonts := self currentSelection. - self warningSeen ifFalse: [ - (Project uiManager confirm: ( - 'Note that linking a font instead of importing may make the - image un-portable, since the linked font must be present on - the system the next time the image is run. - - This warning is only shown once per session.' translated) trueChoice: 'Proceed' translated falseChoice: 'Cancel' translated) - ifFalse: [^ self]. - self warningSeen: true].. - filenames := fonts allFilenames. - filenames do: [:filename | | readFonts | - readFonts := TTFileDescription readFontsFrom: filename. - readFonts isCollection - ifFalse: [TTCFont newTextStyleFromTT: readFonts] - ifTrue: [self importFontFamily: readFonts]]. - self allFonts: nil. "force redraw" - TTCFont registerAll.! Item was added: + ----- Method: FontImporterTool>>offerPreviewTextMenu (in category 'preview text') ----- + offerPreviewTextMenu + + | builder menuSpec | + builder := ToolBuilder default. + menuSpec := builder pluggableMenuSpec new. + + #(textSample codeSample widgetSample nil forssmanSample melvilleSample fontSample) do: [:selector | + selector ifNil: [menuSpec addLine] ifNotNil: [ + | item marker | + marker := (customPreviewText isEmptyOrNil and: [previewTextSelector = selector]) + ifTrue: ['<yes>'] ifFalse: ['<no>']. + item := menuSpec + add: marker, (self previewTextSelectorLabelFor: selector) + target: self + selector: #setPreviewTextSelector: + argumentList: {selector}. + item help: (self previewTextSelectorHelpFor: selector)]]. + menuSpec addLine. + + (CustomPreviewTexts ifNil: [CustomPreviewTexts := OrderedCollection new]) + do: [:text | | marker | + marker := customPreviewText = text ifTrue: ['<yes>'] ifFalse: ['<no>']. + menuSpec + add: marker, (text contractTo: 40) + target: self + selector: #setCustomPreviewText: + argumentList: {text}]. + CustomPreviewTexts ifNotEmpty: [menuSpec addLine]. + + menuSpec + add: 'Discard custom texts' translated + target: self + selector: #discardCustomPreviewTexts + argumentList: #(). + + builder runModal: (builder open: menuSpec).! Item was added: + ----- Method: FontImporterTool>>okToClose (in category 'ui - building') ----- + okToClose + "Check for modifications to not installed fonts. Ask the user if those modifications should be discarded. Not that modifications to installed fonts were already applied." + + | modifiedFonts | + modifiedFonts := self allFonts "top level" select: [:ea | ea isModified and: [ea isInstalled not]]. + ^ (super okToClose and: [modifiedFonts isEmpty]) + ifTrue: [true] + ifFalse: [Project uiManager + confirm: ('You modified the following fonts:\\' translated, + (modifiedFonts inject: '' into: [:list :each | list, ' ', each fontname, '\']), + '\These fonts are not yet installed. Do\you want to discard your changes?' translated) withCRs + title: 'Discard Changes' translated]! Item was added: + ----- Method: FontImporterTool>>pointSize (in category 'preview text - ui') ----- + pointSize + + ^ pointSize ifNil: [TextStyle defaultFont pointSize]! Item was added: + ----- Method: FontImporterTool>>pointSizeInput (in category 'preview text - ui') ----- + pointSizeInput + + ^ self pointSize asString! Item was added: + ----- Method: FontImporterTool>>pointSizeInput: (in category 'preview text - ui') ----- + pointSizeInput: anObject + + self currentSelection ifNil: [^ false]. + + pointSize := [anObject asNumber roundTo: 0.5] on: NumberParserError do: [TextStyle defaultFont pointSize]. + pointSize := pointSize max: 1.0. + self changed: #pointSizeInput. + self selectedFont: nil. + + ^ true! Item was added: + ----- Method: FontImporterTool>>pointSizeInputHelp (in category 'preview text - ui') ----- + pointSizeInputHelp + + self editModeEnabled ifFalse: [ + ^ 'Point size in the preview box' translated]. + + ^ ('Point size in the preview box. The system''s default is currently {1} points. It is recommended to adjust the font''s extra glyph scale and extra line gap using the default point size. Look at other text in the system to assess whether this font would integrate nicely. Make empty to reset to default value.' translated + format: {TextStyle defaultFont pointSize}) asTextFromHtml! Item was added: + ----- Method: FontImporterTool>>prepareEditMode: (in category 'edit mode') ----- + prepareEditMode: container + + Project current isMorphic ifFalse: [^ self]. + + editModeWidgets := Dictionary new + at: #on put: OrderedCollection new; + at: #off put: OrderedCollection new; + yourself. + + container allMorphsDo: [:m | + ((m knownName ifNil: ['']) beginsWith: 'edit') + ifTrue: [(editModeWidgets at: #on) add: m] + ifFalse: [((m knownName ifNil: ['']) beginsWith: 'toggle') + ifTrue: [(editModeWidgets at: #off) add: m]]]. + + self toggleEditMode. "Turn it off"! Item was removed: - ----- Method: FontImporterTool>>previewFrame (in category 'layout') ----- - previewFrame - - ^ LayoutFrame - fractions: (0.4@0 corner: 1@1) - offsets: (0@0 corner: 0@ self buttonHeight negated)! Item was changed: + ----- Method: FontImporterTool>>previewText (in category 'preview text') ----- - ----- Method: FontImporterTool>>previewText (in category 'model access') ----- previewText + "Answer the current preview text. Avoid using a text with font-reference attributes so that any not-yet-installed font does not get spreaded across the system. See #selectedFontTextStyle to learn how the preview is rendered using the selected font." + self selectedFont ifNil: [^ '']. + self customPreviewText ifNotEmpty: [:text | ^ text withCRs]. + + previewTextSelector = #fontSample ifTrue: [ + ^ self selectedFont ttcDescription sampleText + ifEmpty: ['This font does not provide a sample text.' translated]]. + + (previewTextSelector ~= #textSample and: [self selectedFont isSymbolFont]) + ifTrue: [^ 'This symbol font does not support the preview text.\Please use ''Text/Symbol'' or type a custom text.' translated withCRs asText addAttribute: (TextFontReference toFont: TextStyle defaultFont); yourself]. + + self selectedFont isSymbolFont + ifTrue: [^ self selectedFont symbolSample asString]. + (Text respondsTo: previewTextSelector) + ifTrue: [^ (Text perform: previewTextSelector) asString]. + previewTextSelector = #widgetSample + ifTrue: [^ self widgetSample]. + + ^ ''! - ^ self selectedFont - ifNil: [Text new] - ifNotNil: [:font | font sampleText]! Item was added: + ----- Method: FontImporterTool>>previewTextButtonHelp (in category 'preview text') ----- + previewTextButtonHelp + + ^ self customPreviewText + ifNotEmpty: [^ 'Custom ->' "The arrow points to the input field in the UI."] + ifEmpty: [self previewTextSelectorHelpFor: previewTextSelector]! Item was added: + ----- Method: FontImporterTool>>previewTextButtonLabel (in category 'preview text') ----- + previewTextButtonLabel + + ^ self customPreviewText + ifNotEmpty: ['Custom ->'] + ifEmpty: [self previewTextSelectorLabelFor: previewTextSelector]! Item was added: + ----- Method: FontImporterTool>>previewTextMenu:shifted: (in category 'preview text') ----- + previewTextMenu: aMenu shifted: shifted + <previewTextMenu> + "See commentary in StringHolder >> #mainCodePaneMenu:shifted:." + + ^ StringHolder codePaneMenu: aMenu shifted: shifted! Item was added: + ----- Method: FontImporterTool>>previewTextPadding (in category 'preview text') ----- + previewTextPadding + "Static. Give a little bit more space so that the user can focus on the font, not the window ui. For UI themes that use bitmap fonts (i.e., the default 75%, 100%, 125%, and 150% scale factor) use the current font metrics. Otherwise, just use a font-agnostic measure in points. Maybe we can make text-field margins more dynamic (and per-font) in the future." + + ^ UserInterfaceTheme current isTTCBased + ifTrue: [(TextStyle pointsToPixels: 16 "pt" @20 "pt") truncated] + ifFalse: [(TextStyle defaultFont widthOf: $m) @ TextStyle defaultFont lineGrid]! Item was added: + ----- Method: FontImporterTool>>previewTextSelectorHelpFor: (in category 'preview text') ----- + previewTextSelectorHelpFor: symbol + + ^ symbol caseOf: { + [#textSample] -> ['See the font''s alphabet as a dummy text. For symbol fonts, show a selection of symbols.' translated]. + [#codeSample] -> ['See how the font would render some Smalltalk source code.' translated]. + [#forssmanSample] -> ['See an example of ragged text used in the book "Detailtypografie" by Friedrich Forssman and Ralf de Jong.' translated]. + [#melvilleSample] -> ['See the first two paragraphs of "Moby Dick" by Herman Melville.' translated]. + [#fontSample] -> ['See the example text that was provided by the font designer in the font description itself.' translated asTextFromHtml]. + [#widgetSample] -> ['See how the font would look in a list, tree, or menu widget.' translated]. + } otherwise: [ '' ]! Item was added: + ----- Method: FontImporterTool>>previewTextSelectorLabelFor: (in category 'preview text') ----- + previewTextSelectorLabelFor: symbol + + ^ symbol caseOf: { + [#textSample] -> ['Text/Symbols']. + [#codeSample] -> ['Source code']. + [#widgetSample] -> ['Widgets']. + [#forssmanSample] -> ['Forssman']. + [#melvilleSample] -> ['Melville']. + [#fontSample] -> ['Font sample']. + } otherwise: [ '???' ]! Item was added: + ----- Method: FontImporterTool>>resetFontMetrics (in category 'edit mode - actions') ----- + resetFontMetrics + + self selectedFont familyName = TextStyle defaultTTFont familyName + ifTrue: [^ self inform: 'You should not reset the font that is used as\reference for x-height adjustment. Please\change manually if at all.' translated withCRs]. + + self toggleEditMode. + + pointSize := nil. + lineSpacing := nil. + + self currentSelection ifNotNil: [:fontDescr | + fontDescr ttExtraScale: nil. + fontDescr ttExtraGap: nil]. + + self changed: #objectChanged with: self currentSelection. + self selectedFont: nil. ! Item was changed: + ----- Method: FontImporterTool>>selectedFont (in category 'accessing') ----- - ----- Method: FontImporterTool>>selectedFont (in category 'font list') ----- selectedFont + + ^ selectedFont ifNil: [selectedFont := self currentSelection + ifNil: [TextStyle defaultFont] + ifNotNil: [:o | o fontOfPointSize: self pointSize] ]! - | fontDesc font | - fontDesc := self currentSelection. - font := self fontFromFamily: fontDesc. - font isFontSet ifTrue: [ - font := (self currentParent isNil or: [self currentParent = self currentSelection]) - ifTrue: [font fontArray anyOne] - ifFalse: [ "we have selected a leaf " - font fontArray - detect: [:subfont | subfont subfamilyName = fontDesc fontname] - ifNone: [font]]]. - ^font emphasized: emphasis! Item was added: + ----- Method: FontImporterTool>>selectedFont: (in category 'accessing') ----- + selectedFont: aTTCFont + + selectedFont := aTTCFont. + + self changed: #previewText. + self changed: #selectedFontTextStyle. + + self changed: #filename. + self changed: #copyright. + + self changed: #pointSizeInput. + self changed: #lineSpacingInput. + self changed: #ttExtraScaleInput. + self changed: #ttExtraGapInput. + + self changed: #installButtonColor. + self changed: #installButtonLabel. + self changed: #installButtonEnabled. + + self changed: #windowTitle.! Item was changed: + ----- Method: FontImporterTool>>selectedFontTextStyle (in category 'accessing') ----- - ----- Method: FontImporterTool>>selectedFontTextStyle (in category 'font list') ----- selectedFontTextStyle + "Construct a new text style from the #selectedFont." + + ^ (TextStyle fontArray: {self selectedFont}) + lineSpacing: ((lineSpacing isNil and: [self selectedFont isSymbolFont]) + ifTrue: [ 0.3 ] + ifFalse: [ self lineSpacing ]); + yourself + + ! - - | font | - ^ (font := self selectedFont) isSymbolFont - ifFalse: [TextStyle fontArray: {font}] - ifTrue: [TextStyle default copy]! Item was added: + ----- Method: FontImporterTool>>setCustomPreviewText: (in category 'preview text - custom') ----- + setCustomPreviewText: aString + + self editCustomPreviewText: aString. + self changed: #customPreviewText.! Item was added: + ----- Method: FontImporterTool>>setPreviewTextSelector: (in category 'preview text') ----- + setPreviewTextSelector: symbol + + previewTextSelector := symbol. + self setCustomPreviewText: nil.! Item was removed: - ----- Method: FontImporterTool>>textForFamily:subfamily: (in category 'helper') ----- - textForFamily: familyName subfamily: subfamilyName - - subfamilyName ifNil: [ - ^ (TextStyle named: (familyName copyWithout: Character space)) - ifNil: [familyName] - ifNotNil: [:style | style isTTCStyle - ifTrue: ["we are already present " - Text string: familyName attribute: TextEmphasis underlined] - ifFalse: [familyName]]]. - - " frome here on it is only about subfamilies" - - (self isStyleNameSupported: subfamilyName) - ifFalse: [^ Text string: subfamilyName attribute: TextColor gray]. - - ^ (TextStyle named: familyName) - ifNil: ["importable" subfamilyName] - ifNotNil: [:style | - (style isTTCStyle and: [ | regular emph | - regular := style fonts anyOne. - emph := TTCFont indexOfSubfamilyName: subfamilyName. - " detect if this style is already imported " - regular emphasis = emph or: [(regular emphasis: emph) ~= regular]]) - ifFalse: ["again importable" subfamilyName] - ifTrue: [Text string: subfamilyName attribute: TextEmphasis underlined]]! Item was added: + ----- Method: FontImporterTool>>toggleEditMode (in category 'edit mode') ----- + toggleEditMode + + self editModeEnabled: self editModeEnabled not.! Item was added: + ----- Method: FontImporterTool>>ttExtraGapInput (in category 'edit mode - ui') ----- + ttExtraGapInput + + ^ (self currentSelection + ifNil: [0] + ifNotNil: [:handle | handle ttExtraGap]) asString! Item was added: + ----- Method: FontImporterTool>>ttExtraGapInput: (in category 'edit mode - ui') ----- + ttExtraGapInput: anObject + + self currentSelection ifNil: [^ false]. + + self currentSelection ttExtraGap: ([anObject asNumber truncated] on: NumberParserError do: [nil]). + self changed: #ttExtraGapInput. + self changed: #objectChanged with: self currentSelection. + + self selectedFont: nil. + + ^ true! Item was added: + ----- Method: FontImporterTool>>ttExtraGapInputHelp (in category 'edit mode - ui') ----- + ttExtraGapInputHelp + + | tt | + tt := self selectedFont ifNotNil: [:f | f isTTCFont ifTrue: [ f ttcDescription ] ]. + ^ ('Extra line gap in font measures. This font''s own value is {1} with units-per-em (UPM) being {2}. Adjust to change the font''s line grid (or "height") to compensate for extra glyph scale. The value may be negative. Note that there is also line spacing, which is not per font but per text style and thus application-specific. Make empty to reset to default value.' translated + format: { + tt ifNil: ['?'] ifNotNil: [tt typographicLineGap]. + tt ifNil: ['?'] ifNotNil: [tt unitsPerEm]. + }) asTextFromHtml! Item was added: + ----- Method: FontImporterTool>>ttExtraScaleInput (in category 'edit mode - ui') ----- + ttExtraScaleInput + + ^ (self currentSelection + ifNil: [1.0] + ifNotNil: [:handle | handle ttExtraScale]) printShowingDecimalPlaces: 3! Item was added: + ----- Method: FontImporterTool>>ttExtraScaleInput: (in category 'edit mode - ui') ----- + ttExtraScaleInput: anObject + + self currentSelection ifNil: [^ false]. + + self currentSelection ttExtraScale: ([anObject asNumber] on: NumberParserError do: [nil]). + self changed: #ttExtraScaleInput. + self changed: #objectChanged with: self currentSelection. + + self selectedFont: nil. + + ^ true! Item was added: + ----- Method: FontImporterTool>>ttExtraScaleInputHelp (in category 'edit mode - ui') ----- + ttExtraScaleInputHelp + + (self selectedFont isNil or: [self selectedFont isTTCFont not]) + ifTrue: [ ^ '']. + + ^ ('Extra glyph scale to accommodate varying heights when using different fonts side-by-side. This font has a relative x-height of {1} while the system''s reference is {2}. You can only use values greater than 0.0. Note that this does not change the font''s "pixel height" and is thus unrelated to the system''s overall UI scale factor. You may want to adjust extra line gap as well to retain the font''s aesthetics. Make empty to reset to default value.' translated + format: { + self selectedFont xHeightFraction printShowingDecimalPlaces: 3. + TextStyle defaultTTFont xHeightFraction printShowingDecimalPlaces: 3 }) asTextFromHtml! Item was added: + ----- Method: FontImporterTool>>uninstallColor (in category 'ui - colors') ----- + uninstallColor + + ^ (UserInterfaceTheme current get: #cancel for: #ListChooser) ifNil: [Color r: 1 g: 0.6 b: 0.588]! Item was added: + ----- Method: FontImporterTool>>uninstallFont (in category 'actions') ----- + uninstallFont + + (Project uiManager + confirm: ('Do you want to uninstall the following font?\\ ' translated, + self currentSelection familyName, + '\\(There may be references left to this font\in text attributes and text styles.)' translated) withCRs + title: 'Uninstall Font' translated) ifFalse: [^ false]. + + self currentSelection uninstallFont. + + self currentSelection parent ifNotNil: [:p | self currentSelection: p]. + self changed: #objectChanged with: self currentSelection. + + ^ true! Item was removed: - ----- Method: FontImporterTool>>warningSeen (in category 'accessing') ----- - warningSeen - - ^ warningSeen ifNil: [false]! Item was removed: - ----- Method: FontImporterTool>>warningSeen: (in category 'accessing') ----- - warningSeen: anObject - - warningSeen := anObject! Item was added: + ----- Method: FontImporterTool>>widgetSample (in category 'preview text') ----- + widgetSample + + ^ self widgetSampleFor: self selectedFont! Item was added: + ----- Method: FontImporterTool>>widgetSampleFor: (in category 'preview text') ----- + widgetSampleFor: font + + | widgets data preferredWidth | + data := ChronologyConstants classPool at: #MonthNames. + widgets := OrderedCollection new. + preferredWidth := ((font widthOfString: (data detectMax: [:ea | ea size])) * 1.3) truncated. + + "1) List morph" + widgets add: ((PluggableListMorph on: data list: #value selected: nil changeSelected: nil) vResizing: #shrinkWrap; width: preferredWidth; font: font; yourself). + + "2) Menu morph" + widgets add: (MenuMorph new in: [:menu | data do: [:o | menu add: o action: #yourself. menu lastItem font: font]. menu]). + + "3) Buttons" + widgets add: (Morph new color: Color transparent; changeTableLayout; listDirection: #topToBottom; vResizing: #shrinkWrap; cellGap: (font widthOf: Character space); width: preferredWidth; addAllMorphs: (data collect: [:ea | (PluggableButtonMorph on: ea getState: nil action: #yourself label: #yourself) hResizing: #spaceFill; font: font; fullBounds; in: [:button | MorphicProject useCompactButtons ifFalse: [button vResizing: #rigid; height: button height * 1.6; flag: #magicNumber]]; yourself ])). + + ^ Text streamContents: [:sample | + widgets + do: [:widget | + widget textAnchorProperties verticalAlignment: #top. + sample nextPutAll: ( + Text + string: Character startOfHeader asString + attribute: widget asTextAnchor)] + separatedBy: [sample space: 5]]! Item was changed: + ----- Method: FontImporterTool>>windowTitle (in category 'ui - building') ----- - ----- Method: FontImporterTool>>windowTitle (in category 'toolbuilder') ----- windowTitle + ^ 'Font Importer', (self currentSelection + ifNil: [''] + ifNotNil: [:desc | ': ', desc familyName])! - ^'Choose a Font to import' translated! Item was changed: ----- Method: TTFontDescription>>asMorph (in category '*Morphic-TrueType') ----- asMorph + + ^ self asHandle font + browseAllGlyphs; + browseAllGlyphsByCategory; + browseAllSymbols; + yourself. + + "^TTSampleFontMorph font: self"! - ^TTSampleFontMorph font: self!

3 2

The Trunk: ToolBuilder-Morphic-mt.308.mcz
by commits＠source.squeak.org 06 Apr '22

06 Apr '22

Marcel Taeumel uploaded a new version of ToolBuilder-Morphic to project The Trunk: http://source.squeak.org/trunk/ToolBuilder-Morphic-mt.308.mcz ==================== Summary ==================== Name: ToolBuilder-Morphic-mt.308 Author: mt Time: 14 March 2022, 4:39:06.716786 pm UUID: bbb9bbdb-e30d-9243-8123-ea7b6a828e32 Ancestors: ToolBuilder-Morphic-mt.307 Fixes regression in expand button in list-chooser dialogs. Allow longer text lines in pluggable dialogs (e.g., file-save dialog). Make #softLineWrapAtVisualWrapBorder preference functional. Still disabled by default. Only for source-code panes. Tweak #initialExtent in list-chooser dialogs. =============== Diff against ToolBuilder-Morphic-mt.307 =============== Item was changed: ----- Method: DirectoryChooserDialog>>initialExtent (in category 'toolbuilder') ----- initialExtent "Since this is a single list it can be a bit narrower than a FileChooserDialog" + ^ super initialExtent * (0.6 @ 1)! - ^ super initialExtent * (0.5 @ 1)! Item was changed: ----- Method: ListChooser>>initialExtent (in category 'building') ----- initialExtent + | listFont listStyle itemCount maxItemSize | - | listFont itemCount maxItemSize cellSize | listFont := Preferences standardListFont. + listStyle := listFont asNewTextStyle. itemCount := items size. + maxItemSize := (items take: 15) inject: 0 into: [:max :item | max max: item asString size]. - maxItemSize := items inject: 0 into: [:max :item | max max: item asString size]. - cellSize := (listFont widthOf: $m) @ listFont height. + ^ (listStyle compositionWidthFor: (maxItemSize min: 50 max: 35)) - ^ ((maxItemSize min: 20 max: 10) * (listFont widthOf: $m)) @ ((ToolBuilder default listHeightFor: (itemCount min: 15 max: 5)) + self searchBarHeight + ToolBuilder default dialogSpacing)! Item was changed: ----- Method: ListMultipleChooser>>initialExtent (in category 'toolbuilder') ----- initialExtent + | listFont listStyle itemCount maxItemSize | - | listFont itemCount maxItemSize | listFont := Preferences standardListFont. + listStyle := listFont asNewTextStyle. itemCount := labels size. + maxItemSize := (labels take: 15) inject: 0 into: [:max :item | max max: item asString size]. - maxItemSize := labels inject: 0 into: [:max :item | max max: item asString size]. + ^ (listStyle compositionWidthFor: (maxItemSize min: 50 max: 35)) - ^ ((maxItemSize min: 20 max: 10) * (listFont widthOf: $m)) @ (ToolBuilder default listHeightFor: (itemCount min: 15 max: 5))! Item was changed: ----- Method: MorphicToolBuilder>>buildPluggableCodePane: (in category 'widgets optional') ----- buildPluggableCodePane: aSpec | widget | widget := super buildPluggableCodePane: aSpec. "Override code-specific default properties." widget wantsWrapBorder: PluggableTextMorph visualWrapBorder. + PluggableTextMorph softLineWrapAtVisualWrapBorder + ifTrue: [widget numCharactersPerLine: PluggableTextMorph visualWrapBorderLimit]. widget wrapFlag: (aSpec softLineWrap ifNil: [PluggableTextMorph softLineWrap]). ^ widget! Item was changed: ----- Method: MorphicToolBuilder>>buildPluggableDialog: (in category 'widgets optional') ----- buildPluggableDialog: aSpec | widget | widget := self dialogClass new. self register: widget id: aSpec name. widget model: aSpec model. "Set child dependent layout properties. The pane morph holds the special contents." widget paneMorph wantsPaneSplitters: (aSpec wantsResizeHandles ifNil: [true]). self setLayoutHintsFor: widget paneMorph spec: aSpec. widget paneMorph layoutInset: (aSpec padding ifNil: [self dialogPadding]). widget morphicLayerNumber: widget class dialogLayer. "Performance. Flip the #wantsPaneSplitters flag only after all children where added." widget paneMorph cellGap: 0. widget paneMorph wantsPaneSplitters: false; wantsGrips: false. widget paneMorph removePaneSplitters; removeGrips. "Now create the children." panes := OrderedCollection new. aSpec children isSymbol ifTrue: [ widget getChildrenSelector: aSpec children. widget update: aSpec children] ifFalse: [ self buildAll: aSpec children in: widget paneMorph]. "Avoid strange behavior in #addMorph:fullFrame:" widget paneMorph cellGap: (aSpec spacing ifNil: [self dialogSpacing]). widget paneMorph wantsPaneSplitters: (aSpec wantsResizeHandles ifNil: [true]). widget paneMorph wantsPaneSplitters ifTrue: [ widget paneMorph wantsGrips: true. widget paneMorph addPaneSplitters; addCornerGrips"; addEdgeGrips". widget paneMorph grips do: [:ea | ea showHandle: true]]. + "Increase the line width of the dialog's message to allow that longer messages accompany complex paneMorph contents." + widget messageMorph numCharactersPerLine: 65. + "Now create the buttons." aSpec buttons isSymbol ifTrue: [ widget getButtonsSelector: aSpec buttons. widget update: aSpec buttons] ifFalse: [ self buildAll: aSpec buttons in: widget buttonRowMorph. widget updateButtonProperties]. aSpec title ifNotNil: [:label | label isSymbol ifTrue:[widget getTitleSelector: label; update: label] ifFalse:[widget title: label]]. aSpec message ifNotNil: [:label | label isSymbol ifTrue:[widget getMessageSelector: label; update: label] ifFalse:[widget message: label]]. "Interaction behavior." aSpec autoCancel ifNotNil: [:b | widget autoCancel: b]. aSpec exclusive ifNotNil: [:b | widget exclusive: b]. widget closeDialogSelector: aSpec closeAction. self buildHelpFor: widget spec: aSpec. "Everything is shrink-wrapped around the pane morph." widget paneMorph extent: (aSpec extent ifNil:[widget initialExtent]) + (widget paneMorph layoutInset * 2) asPoint. ^ widget! Item was changed: ----- Method: PluggableDialogWindow>>expandDialogPane (in category 'running') ----- expandDialogPane "Expand the dialog pane to its preferred extent, including the pane's extra layout inset used for grips. Then try again to move to the dialog's preferred position." | extra | self flag: #preferredExtentWorkaround. "mt: Working with a widget's min, max, and preferred extent is still very awkward using proportional layouts and layout frames. For now, approximate extra spacing to accommodate ListChooser and ListMultipleChooser only." + extra := PluggableListMorph listMargins. + extra := extra topLeft + extra bottomRight. - extra := LazyListMorph new cellInset. extra := extra topLeft + extra bottomRight. self paneMorph extent: (self model preferredExtent + (self paneMorph layoutInset * 2) asPoint + extra). self moveToPreferredPosition.!

3 2

The Trunk: Morphic-mt.1931.mcz
by commits＠source.squeak.org 06 Apr '22

06 Apr '22

Marcel Taeumel uploaded a new version of Morphic to project The Trunk: http://source.squeak.org/trunk/Morphic-mt.1931.mcz ==================== Summary ==================== Name: Morphic-mt.1931 Author: mt Time: 11 March 2022, 10:03:20.148495 am UUID: b4055ef5-466d-604e-be51-2affcbba4e6a Ancestors: Morphic-mt.1930 Improves compromise for keyboard shortcuts in TextEditor and SmalltalkTextEditor regarding [CMD]+[0..9]: - [1..5] No TextFontChange anymore in TextEditor bc. incompatible with scale factor and TrueType fonts - [1..4] still argument name insert in SmalltalkEditor - [5] opens emphasis menu (was [6]) - [6..9] add typical emphases: #bold #italic #underlined #struckOut - No #narrow anymore (was [8]) - [0] still removes those emphases - No support for US-only [=/-] anymore; was used for text kern +/- 1 Note that [CTRL]+[0..9] is not affected by this change. =============== Diff against Morphic-mt.1930 =============== Item was changed: ----- Method: SmalltalkEditor>>changeEmphasis: (in category 'editing keys') ----- changeEmphasis: characterStream + "Change emphasis without styling if necessary. NOTE THAT [cmd]+[1..4] will insert the name of the method argument number n." + - "Change emphasis without styling if necessary" self styler ifNil: [^super changeEmphasis: characterStream]. ^ self styler evaluateWithoutStyling: [super changeEmphasis: characterStream].! Item was changed: ----- Method: TextEditor class>>initializeCmdKeyShortcuts (in category 'keyboard shortcut tables') ----- initializeCmdKeyShortcuts "Initialize the (unshifted) command-key (or alt-key) shortcut table." "NOTE: if you don't know what your keyboard generates, use Sensor kbdTest" "TextEditor initialize" | cmdMap cmds | cmdMap := Array new: 256 withAll: #noop:. "use temp in case of a crash" cmdMap at: 1 + 1 put: #cursorHome:. "home key" cmdMap at: 4 + 1 put: #cursorEnd:. "end key" cmdMap at: 8 + 1 put: #backspace:. "ctrl-H or delete key" cmdMap at: 11 + 1 put: #cursorPageUp:. "page up key" cmdMap at: 12 + 1 put: #cursorPageDown:. "page down key" cmdMap at: 13 + 1 put: #crWithIndent:. "cmd-Return" cmdMap at: 27 + 1 put: #offerMenuFromEsc:. "escape key" cmdMap at: 28 + 1 put: #cursorLeft:. "left arrow key" cmdMap at: 29 + 1 put: #cursorRight:. "right arrow key" cmdMap at: 30 + 1 put: #cursorUp:. "up arrow key" cmdMap at: 31 + 1 put: #cursorDown:. "down arrow key" cmdMap at: 32 + 1 put: #selectWord:. "space bar key" cmdMap at: 127 + 1 put: #forwardDelete:. "del key" + '0123456789' - '0123456789-=' do: [:char | cmdMap at: char asciiValue + 1 put: #changeEmphasis:]. cmds := #($a #selectAll: $c #copySelection: $e #exchange: $f #find: $g #findAgain: $j #doAgain: $k #offerFontMenu: $u #align: $v #paste: $w #backWord: $x #cut: $y #swapChars: $z #undo:). 1 to: cmds size by: 2 do: [:i | cmdMap at: (cmds at: i) asciiValue + 1 put: (cmds at: i + 1)]. cmdActions := cmdMap! Item was changed: ----- Method: TextEditor>>changeEmphasis: (in category 'editing keys') ----- changeEmphasis: aKeyboardEvent "Change the emphasis of the current selection or prepare to accept characters with the change in emphasis. Emphasis change amounts to a font change. Keeps typeahead." + "[cmd]+[0..9]" - "control 0..9 -> 0..9" | keyCode attribute oldAttributes index thisSel colors extras | + keyCode := ('0123456789' indexOf: aKeyboardEvent keyCharacter ifAbsent: [1]) - 1. - keyCode := ('0123456789-=' indexOf: aKeyboardEvent keyCharacter ifAbsent: [1]) - 1. oldAttributes := paragraph text attributesAt: self pointIndex. thisSel := self selection. + "mt: Index-based font changes are not compatible with variable point sizes in text styles. Make room for other shortcuts. + (keyCode between: 1 and: 5) ifTrue: [attribute := TextFontChange fontNumber: keyCode]." - "Decipher keyCodes for Command 0-9..." - (keyCode between: 1 and: 5) - ifTrue: [attribute := TextFontChange fontNumber: keyCode]. + keyCode = 5 - keyCode = 6 ifTrue: [ colors := #(#black #magenta #red #yellow #green #blue #cyan #white). extras := self emphasisExtras. + index := Project uiManager chooseFrom: colors , #('choose color...' ), extras. - index := UIManager default chooseFrom:colors , #('choose color...' ), extras - lines: (Array with: colors size + 1). index = 0 ifTrue: [^true]. index <= colors size ifTrue: [attribute := TextColor color: (Color perform: (colors at: index))] ifFalse: [ index := index - colors size - 1. "Re-number!!!!!!" index = 0 ifTrue: [attribute := self chooseColor] ifFalse:[^self handleEmphasisExtra: index with: aKeyboardEvent] "handle an extra"]]. + (keyCode between: 6 and: 9) - (keyCode between: 7 and: 11) ifTrue: [ aKeyboardEvent shiftPressed + ifTrue: [ "Cannot be reached bc. method entry is #keyCharacter based and thus dependent on keyboard layout." + keyCode = 6 ifTrue: [attribute := TextKern kern: -1]. + keyCode = 7 ifTrue: [attribute := TextKern kern: 1]] - ifTrue: [ - keyCode = 10 ifTrue: [attribute := TextKern kern: -1]. - keyCode = 11 ifTrue: [attribute := TextKern kern: 1]] ifFalse: [ + attribute := TextEmphasis + perform: (#(#bold #italic #underlined #struckOut) at: keyCode - 5). + oldAttributes - attribute := TextEmphasis - perform: (#(#bold #italic #narrow #underlined #struckOut) at: keyCode - 6). - oldAttributes do: [:att | (att dominates: attribute) ifTrue: [attribute turnOff]]]]. keyCode = 0 ifTrue: [attribute := TextEmphasis normal]. attribute ifNotNil: [ thisSel size = 0 ifTrue: [ "only change emphasisHere while typing" self insertTypeAhead. emphasisHere := Text addAttribute: attribute toArray: oldAttributes ] ifFalse: [ self replaceSelectionWith: (thisSel asText addAttribute: attribute) ]]. ^true!

4 3

The Trunk: Morphic-ct.1960.mcz
by commits＠source.squeak.org 06 Apr '22

06 Apr '22

Christoph Thiede uploaded a new version of Morphic to project The Trunk: http://source.squeak.org/trunk/Morphic-ct.1960.mcz ==================== Summary ==================== Name: Morphic-ct.1960 Author: ct Time: 6 April 2022, 7:32:52.190385 pm UUID: 7632c359-d7f1-5b46-abf1-a988d4e4db7c Ancestors: Morphic-mt.1957 Minor clean-up of MenuMorph's matchString. Add public accessors for filtering. Simplifies the value range of the match string by automatically converting '' to nil. Deprecates unused #unfilterOrEscape:. =============== Diff against Morphic-mt.1957 =============== Item was changed: ----- Method: MenuMorph>>displayFiltered: (in category 'keyboard control') ----- displayFiltered: evt | matchStr allItems matches feedbackMorph | + matchStr := self matchString. - matchStr := self valueOfProperty: #matchString. allItems := self submorphs select: [:m | m isKindOf: MenuItemMorph]. matches := allItems select: [:m | | isMatch | isMatch := + matchStr isNil or: [ - matchStr isEmpty or: [ m contents includesSubstring: matchStr caseSensitive: false]. m isEnabled: isMatch. isMatch]. feedbackMorph := self valueOfProperty: #feedbackMorph. feedbackMorph ifNil: [ feedbackMorph := TextMorph new color: Color darkGray; yourself. self addLine; addMorphBack: feedbackMorph lock. self setProperty: #feedbackMorph toValue: feedbackMorph. self fullBounds. "Lay out for submorph adjacency"]. feedbackMorph contents: '<', matchStr, '>'. + matchStr ifNil: [ - matchStr isEmpty ifTrue: [ feedbackMorph delete. self submorphs last delete. self removeProperty: #feedbackMorph]. " This method is invoked with evt = nil from MenuMorph >> removeMatchString. The current implementation can't select an item without an event. " (evt notNil and: [ matches size >= 1 ]) ifTrue: [ self selectItem: matches first event: evt]! Item was changed: ----- Method: MenuMorph>>handleDelStroke: (in category 'keystroke helpers') ----- handleDelStroke: evt evt keyCharacter = Character delete ifFalse: [^ false]. + self matchString ifNotNil: [ + self removeMatchString]. - self - valueOfProperty: #matchString - ifPresentDo: [:str | "reset filter" - self setProperty: #matchString toValue: String new. - self selectItem: nil event: evt. - self displayFiltered: evt]. ^ true! Item was changed: ----- Method: MenuMorph>>handleEscStroke: (in category 'keystroke helpers') ----- handleEscStroke: evt evt keyValue = 27 ifFalse: [ ^false ]. + self matchString ifNotNil: [ + self removeMatchString. + ^true]. - self - valueOfProperty: #matchString - ifPresentDo: [ :str | - str isEmpty ifFalse: [ "If filtered, first ESC removes filter" - self setProperty: #matchString toValue: String new. - self selectItem: nil event: evt. - self displayFiltered: evt. - ^true ] ]. self deactivate: evt. ^true! Item was changed: ----- Method: MenuMorph>>handleFiltering: (in category 'keystroke helpers') ----- handleFiltering: evt | matchString | + matchString := self matchString. - matchString := self valueOfProperty: #matchString ifAbsentPut: [ String new ]. matchString := true caseOf: { [ evt keyCharacter = Character backspace ] -> + [matchString ifNotNil: [ matchString allButLast ] ]. - [ matchString isEmpty - ifTrue: [ matchString ] - ifFalse: [ matchString allButLast ] ]. [ evt keyValue >= 32 ] -> + [ (matchString ifNil: ['']) , evt keyCharacter ] } - [ matchString , evt keyCharacter ] } otherwise: [ matchString ]. + self matchString: matchString event: evt.! - self setProperty: #matchString toValue: matchString. - self displayFiltered: evt! Item was added: + ----- Method: MenuMorph>>matchString (in category 'accessing') ----- + matchString + "Answer the current match string for filtering the menu, or nil if no filter is active. The matchString will never be an empty string." + + ^ self valueOfProperty: #matchString! Item was added: + ----- Method: MenuMorph>>matchString: (in category 'accessing') ----- + matchString: aString + + ^ self matchString: aString event: nil! Item was added: + ----- Method: MenuMorph>>matchString:event: (in category 'keyboard control') ----- + matchString: aString event: anEvent + "Set the current match string and display the filtered the menu items." + + aString ifNotNil: [aString ifEmpty: [^ self matchString: nil event: anEvent]]. + + self setProperty: #matchString toValue: aString. + self displayFiltered: anEvent.! Item was changed: ----- Method: MenuMorph>>removeMatchString (in category 'keyboard control') ----- removeMatchString + + ^ self removeMatchString: self currentEvent! - "Remove the matchString, if any." - self setProperty: #matchString toValue: String new. - self displayFiltered: nil! Item was added: + ----- Method: MenuMorph>>removeMatchString: (in category 'keyboard control') ----- + removeMatchString: anEvent + "Remove the matchString, if any." + + self selectItem: nil event: anEvent. + self matchString: nil event: anEvent.! Item was removed: - ----- Method: MenuMorph>>unfilterOrEscape: (in category 'keyboard control') ----- - unfilterOrEscape: evt - self valueOfProperty: #matchString - ifPresentDo: - [:str | - - str isEmpty - ifFalse: - ["If filtered, first ESC removes filter" - - self setProperty: #matchString toValue: String new. - self selectItem: nil event: evt. - self displayFiltered: evt]]. - "If a stand-alone menu, just delete it" - popUpOwner ifNil: [^self delete]. - "If a sub-menu, then deselect, and return focus to outer menu" - self selectSuperMenu: evt!

1 0

The Trunk: 60Deprecated-ct.109.mcz
by commits＠source.squeak.org 06 Apr '22

06 Apr '22

Christoph Thiede uploaded a new version of 60Deprecated to project The Trunk: http://source.squeak.org/trunk/60Deprecated-ct.109.mcz ==================== Summary ==================== Name: 60Deprecated-ct.109 Author: ct Time: 6 April 2022, 7:32:46.765385 pm UUID: 5fc3a8e2-429b-044e-a3df-eae0c2200cbe Ancestors: 60Deprecated-ct.108 Complements Morphic-ct.1960 (clean-up of MenuMorph's matchString). =============== Diff against 60Deprecated-ct.108 =============== Item was changed: ----- Method: MenuMorph>>filterListWith: (in category '*60Deprecated-keyboard control') ----- + filterListWith: char + - filterListWith: char | matchString | self deprecated: 'ct: Use #handleFiltering: instead'. + + matchString := self matchString copyWith: char. + matchString := matchString copyWithout: Character backspace. + self matchString: matchString! - matchString := self valueOfProperty: #matchString ifAbsentPut: [String new]. - matchString := char = Character backspace - ifTrue: - [matchString isEmpty ifTrue: [matchString] ifFalse: [matchString allButLast]] - ifFalse: [matchString copyWith: char]. - self setProperty: #matchString toValue: matchString! Item was added: + ----- Method: MenuMorph>>unfilterOrEscape: (in category '*60Deprecated-keyboard control') ----- + unfilterOrEscape: evt + + self deprecated: 'Use #handleEscStroke: instead'. + + self matchString ifNil: [ + self removeMatchString]. + + "If a stand-alone menu, just delete it" + popUpOwner ifNil: [^self delete]. + "If a sub-menu, then deselect, and return focus to outer menu" + self selectSuperMenu: evt.!

1 0

The Trunk: Graphics-mt.507.mcz
by commits＠source.squeak.org 06 Apr '22

06 Apr '22

Marcel Taeumel uploaded a new version of Graphics to project The Trunk: http://source.squeak.org/trunk/Graphics-mt.507.mcz ==================== Summary ==================== Name: Graphics-mt.507 Author: mt Time: 6 April 2022, 11:57:44.501029 am UUID: 98abf5e0-883f-9f42-9e3d-6cb2191866ff Ancestors: Graphics-mt.506 Activate #primitiveScreenScaleFactor bc. most recent OSVM reports NaN for unknown factor, not 1.0. Still report 1.0 for unknown cases to make #platformScaleFactor robust, see #platformScaleFactorKnown. =============== Diff against Graphics-mt.506 =============== Item was changed: ----- Method: DisplayScreen class>>actualScreenScaleFactor (in category 'snapshots') ----- actualScreenScaleFactor + <primitive: #primitiveScreenScaleFactor> - "<primitive: #primitiveScreenScaleFactor>" - "Once the primitive is ready, you can simply uncomment it. The system is prepared for changes from 'nil' to actual factors and back." + ^ Float nan "Unknown scale factor"! - ^ nil "unknown -- do not default to 1.0 here"! Item was changed: ----- Method: DisplayScreen>>platformScaleFactor (in category 'scale factor') ----- platformScaleFactor + "Answers the platform's (and thus monitor's) current scale factor as last reported via VM primitive. See #checkForNewScreenScaleFactor. For robustness, always report a sensible value. However, you should check via #platformScaleFactorKnown whether this value is reliable." - "Answers the platform's (and thus monitor's) current scale factor as last reported via VM primitive. See #checkForNewScreenScaleFactor." ^ PlatformScaleFactor ifNil: [1.0 "Primitive not ready."]! Item was changed: ----- Method: DisplayScreen>>platformScaleFactor: (in category 'scale factor') ----- platformScaleFactor: aFloatOrNil "Report a new scale factor from the platform to the image. This can happen if you move Squeak's window between monitors with different pixels-per-inch. On some platforms, you can also set a scale factor independent of monitor PPI. Note that the user might have scaled the image regardless of the previous platform scale factor." | old new | + (aFloatOrNil isNil or: [aFloatOrNil isNaN]) ifTrue: [ - aFloatOrNil ifNil: [ "Ignore. Primitive not ready (anymore)." PlatformScaleFactor := nil. ^ self]. PlatformScaleFactor ifNil: [ "First time. Ignore. Assume that the user scaled manually until now." + "self assert: [aFloatOrNil notNil]." + "self assert: [aFloatOrNil isNaN not]." PlatformScaleFactor := aFloatOrNil. ^ self]. (old := self platformScaleFactor) = (new := aFloatOrNil) ifTrue: [^ self]. PlatformScaleFactor := new. self uiScaleFactor: self uiScaleFactor * (new/old).!

1 0

The Trunk: System-mt.1305.mcz
by commits＠source.squeak.org 05 Apr '22

05 Apr '22

Marcel Taeumel uploaded a new version of System to project The Trunk: http://source.squeak.org/trunk/System-mt.1305.mcz ==================== Summary ==================== Name: System-mt.1305 Author: mt Time: 9 February 2022, 5:31:22.718056 pm UUID: f02afc35-14e5-274f-b5c2-7ca510faef0d Ancestors: System-mt.1304 Increase standard window extent by about 8% so that the system browsers 'implementors' button's label is not clipped when opening a fresh browser. Works on all scale factors. =============== Diff against System-mt.1304 =============== Item was changed: ----- Method: RealEstateAgent class>>initialize (in category 'class initialization') ----- initialize "Initialize the class variables in the receiver. 5/22/96 sw" "RealEstateAgent initialize" StaggerOffset := 6 @ 20. ReverseStaggerOffset := -6 @ 20. StaggerOrigin := 200 @ 30. + StandardSize := 650 @ 425.! - StandardSize := 600@400.!

5 6

← Newer
1
...
27
28
29
30
31
32
33
34
Older →

Jump to page: