DialogBox.st
changeset 125 3ffa271732f7
parent 122 04ec3fda7c11
child 126 40228f4fd66b
equal deleted inserted replaced
124:7abd3a234296 125:3ffa271732f7
    13 'From Smalltalk/X, Version:2.10.5 on 3-may-1995 at 2:41:07 am'!
    13 'From Smalltalk/X, Version:2.10.5 on 3-may-1995 at 2:41:07 am'!
    14 
    14 
    15 ModalBox subclass:#DialogBox
    15 ModalBox subclass:#DialogBox
    16 	 instanceVariableNames:'buttonPanel okButton okAction abortButton abortAction
    16 	 instanceVariableNames:'buttonPanel okButton okAction abortButton abortAction
    17 		acceptReturnAsOK yPosition leftIndent addedComponents
    17 		acceptReturnAsOK yPosition leftIndent addedComponents
    18 		inputFieldGroup accepted'
    18 		inputFieldGroup acceptOnLeave accepted tabableElements'
    19 	 classVariableNames:''
    19 	 classVariableNames:''
    20 	 poolDictionaries:''
    20 	 poolDictionaries:''
    21 	 category:'Views-DialogBoxes'
    21 	 category:'Views-DialogBoxes'
    22 !
    22 !
    23 
    23 
    24 !DialogBox class methodsFor:'documentation'!
    24 !DialogBox class methodsFor:'documentation'!
    25 
    25 
    26 version
    26 version
    27 "
    27 "
    28 $Header: /cvs/stx/stx/libwidg/DialogBox.st,v 1.11 1995-05-07 00:15:45 claus Exp $
    28 $Header: /cvs/stx/stx/libwidg/DialogBox.st,v 1.12 1995-05-09 01:55:09 claus Exp $
    29 "
    29 "
    30 !
    30 !
    31 
    31 
    32 documentation
    32 documentation
    33 "
    33 "
    69 	addedComponents  <Collection>   programmatically added components
    69 	addedComponents  <Collection>   programmatically added components
    70 
    70 
    71 	inputFieldGroup  <EnterFieldGroup>   
    71 	inputFieldGroup  <EnterFieldGroup>   
    72 					for added input fields
    72 					for added input fields
    73 
    73 
       
    74 	acceptOnLeave    <Boolean>      if true (the default) and there are 
       
    75 					tabable inputFields, accept and close when
       
    76 					the last field is left. If false, the ok
       
    77 					button must be pressed to close the box.
       
    78 
    74 	accepted         <Boolean>      after close: true if box was accepted
    79 	accepted         <Boolean>      after close: true if box was accepted
    75 					(i.e. ok-Button was pressed)
    80 					(i.e. ok-Button was pressed)
    76 
    81 
    77         
    82         
    78     For compatibility with ST-80, this class is also available under
    83     For compatibility with ST-80, this class is also available under
    82 
    87 
    83 examples
    88 examples
    84 "
    89 "
    85     mostly, DialogBox is used as an abstract class as a base for InfoBox, 
    90     mostly, DialogBox is used as an abstract class as a base for InfoBox, 
    86     YesNoBox etc.
    91     YesNoBox etc.
       
    92     For most simple standard dialogs, there are ready to use
       
    93     methods in the class protocol.
       
    94     For example:
       
    95 
       
    96       info & warnings:
       
    97 
       
    98 	Dialog information:'hi there'
       
    99 
       
   100 	Dialog warn:'oops'
       
   101 
       
   102 
       
   103       yes/no questions:
       
   104 
       
   105 	(Dialog confirm:'is this simple ?')
       
   106 	ifTrue:[
       
   107 	    Transcript showCr:'thats what I expected'
       
   108 	] ifFalse:[
       
   109 	    Transcript showCr:'read more examples and documentation'
       
   110 	]
       
   111 
       
   112 
       
   113       yes/no question with cancel option:
       
   114 
       
   115 	|answer|
       
   116 
       
   117 	answer := Dialog confirmWithCancel:'is this simple ?'.
       
   118 	answer isNil ifTrue:[
       
   119 	    Transcript showCr:'no easy decision'
       
   120 	] ifFalse:[
       
   121 	    answer ifTrue:[
       
   122 		Transcript showCr:'thats what I expected'
       
   123 	    ] ifFalse:[
       
   124 		Transcript showCr:'read more examples and documentation'
       
   125 	    ]
       
   126 	]
       
   127 
       
   128 
       
   129       asking for a string:
       
   130 
       
   131 	|s|
       
   132 
       
   133 	s := Dialog request:'enter your name, please:'.
       
   134 	s notNil ifTrue:[
       
   135 	    Transcript showCr:'you entered: ' , s.
       
   136 	]
       
   137 
       
   138 
       
   139       asking for a string with given default:
       
   140 
       
   141 	|s|
       
   142 
       
   143 	s := Dialog 
       
   144 		request:'enter your name, please:'
       
   145 		initialAnswer:(OperatingSystem getLoginName).
       
   146 	s notNil ifTrue:[
       
   147 	    Transcript showCr:'you entered: ' , s.
       
   148 	]
       
   149 
       
   150 
       
   151       asking for a filename:
       
   152 
       
   153 	|s|
       
   154 
       
   155 	s := Dialog 
       
   156 		requestFileName:'select a file, please:'
       
   157 		default:''.
       
   158 	Transcript show:'you entered: '; showCr:s.
       
   159 
       
   160 
       
   161       with changed button label and pattern:
       
   162 
       
   163 	|s|
       
   164 
       
   165 	s := Dialog 
       
   166 		requestFileName:'select a file, please:'
       
   167 		default:''
       
   168 		ok:'show'
       
   169 		abort:'cancel'
       
   170 		pattern:'*.rc'.
       
   171 	Transcript show:'you entered: '; showCr:s.
       
   172 
    87     However, you can construct dialogs programmatically, as shown in
   173     However, you can construct dialogs programmatically, as shown in
    88     the following examples:
   174     the following examples:
    89 
       
    90 
   175 
    91     basic (unusable) example:
   176     basic (unusable) example:
    92 
   177 
    93 	DialogBox new open
   178 	DialogBox new open
    94 
   179 
   186 	    addOkButton; 
   271 	    addOkButton; 
   187 	    open
   272 	    open
   188 
   273 
   189 	DialogBox new
   274 	DialogBox new
   190 	    addTextLabel:'hello';
   275 	    addTextLabel:'hello';
   191 	    addTextLabel:(Image fromFile:'bitmaps/garfield.gif');
   276 	    addTextLabel:((Image fromFile:'bitmaps/garfield.gif')
       
   277 				magnifiedTo:200@150);
   192 	    addTextLabel:'world';
   278 	    addTextLabel:'world';
   193 	    addAbortButton; 
   279 	    addAbortButton; 
   194 	    addOkButton; 
   280 	    addOkButton; 
   195 	    open
   281 	    open
   196 
   282 
   389 
   475 
   390 	box := DialogBox new.
   476 	box := DialogBox new.
   391 	box extent:200@300.
   477 	box extent:200@300.
   392 
   478 
   393 	box addCheckBox:'check1' on:value1.
   479 	box addCheckBox:'check1' on:value1.
       
   480 	box addVerticalSpace.
   394 	box addCheckBox:'check2' on:value2.
   481 	box addCheckBox:'check2' on:value2.
       
   482 	box addVerticalSpace.
   395 	box addCheckBox:'check3' on:value3.
   483 	box addCheckBox:'check3' on:value3.
       
   484 	box addVerticalSpace.
   396 	box addCheckBox:'check4' on:value4.
   485 	box addCheckBox:'check4' on:value4.
   397 
   486 
   398 	box addAbortButton; addOkButton.
   487 	box addAbortButton; addOkButton.
   399 	box open.
   488 	box open.
   400 
   489 
   694 	].
   783 	].
   695     ].
   784     ].
   696     accepted := true.
   785     accepted := true.
   697 !
   786 !
   698 
   787 
       
   788 lastFieldLeft
       
   789     "if the dialog involves input fields, this is called
       
   790      when the last field is left by Return-key or NextField-key"
       
   791 
       
   792     acceptOnLeave ifTrue:[
       
   793 	accepted := true. 
       
   794 	self okPressed
       
   795     ].
       
   796 !
       
   797 
   699 okPressed
   798 okPressed
   700     "user pressed ok-button; make myself invisible and if an action was
   799     "user pressed ok-button; make myself invisible and if an action was
   701      specified do it"
   800      specified do it"
   702 
   801 
   703     okButton notNil ifTrue:[okButton turnOffWithoutRedraw].
   802     okButton notNil ifTrue:[okButton turnOffWithoutRedraw].
   820 	       rightInset:ViewSpacing.
   919 	       rightInset:ViewSpacing.
   821     yPosition := yPosition + aComponent height.
   920     yPosition := yPosition + aComponent height.
   822     ^ aComponent
   921     ^ aComponent
   823 !
   922 !
   824 
   923 
       
   924 addComponent:aComponent tabable:tabable
       
   925     "add a component with its prefered height and full width.
       
   926      Returns the component."
       
   927 
       
   928     tabable ifTrue:[
       
   929 	tabableElements isNil ifTrue:[
       
   930 	    tabableElements := OrderedCollection new
       
   931 	].
       
   932 	tabableElements add:aComponent
       
   933     ].
       
   934     ^ self addComponent:aComponent 
       
   935 	   withHeight:(aComponent preferedExtent y).
       
   936 !
       
   937 
   825 addComponent:aComponent
   938 addComponent:aComponent
   826     "add a component with its prefered height and full width.
   939     "add a component with its prefered height and full width.
   827      Returns the component."
   940      Returns the component."
   828 
   941 
   829     ^ self addComponent:aComponent 
   942     ^ self addComponent:aComponent tabable:false
   830 	   withHeight:(aComponent preferedExtent y).
       
   831 !
   943 !
   832 
   944 
   833 addTextLabel:aString
   945 addTextLabel:aString
   834     "create a text label - the name has been choosen for ST-80 compatibility;
   946     "create a text label - the name has been choosen for ST-80 compatibility;
   835      however, ST/X labels allow image labels too.
   947      however, ST/X labels allow image labels too.
   894      b addOkButton.
  1006      b addOkButton.
   895      b showAtPointer
  1007      b showAtPointer
   896     "
  1008     "
   897 !
  1009 !
   898 
  1010 
       
  1011 addCheckBox:label on:aModel tabable:tabable
       
  1012     "create a checkBox with label on aModel and add it.
       
  1013      Returns the box."
       
  1014 
       
  1015     |b|
       
  1016 
       
  1017     b := CheckBox on:aModel.
       
  1018     b label:label.
       
  1019     self addComponent:b tabable:tabable.
       
  1020     ^ b
       
  1021 !
       
  1022 
   899 addCheckBox:label on:aModel
  1023 addCheckBox:label on:aModel
   900     "create a checkBox with label on aModel and add it.
  1024     "create a checkBox with label on aModel and add it.
   901      Returns the box."
  1025      Returns the box."
   902 
  1026 
   903     |b|
  1027     ^ self addCheckBox:label on:aModel tabable:true
   904 
  1028 !
   905     b := CheckBox on:aModel.
  1029 
   906     b label:label.
  1030 addInputField:aField tabable:tabable
   907     self addComponent:b.
  1031     "add an already created input field; return the field.
   908     ^ b
  1032      If tabable is true, the field is put into a group, to allow
       
  1033      stepping through the fields with #NextField/#PreviousField keys.
       
  1034      Returns the field."
       
  1035 
       
  1036     self addComponent:aField tabable:tabable.
       
  1037     tabable ifTrue:[
       
  1038 	inputFieldGroup isNil ifTrue:[
       
  1039 	    inputFieldGroup := EnterFieldGroup new.
       
  1040 	    inputFieldGroup leaveAction:[self lastFieldLeft].
       
  1041 	    aField hasKeyboardFocus:true.
       
  1042 	].
       
  1043 	inputFieldGroup add:aField.
       
  1044 	self delegate:(KeyboardForwarder to:inputFieldGroup condition:#noFocus).
       
  1045     ].
       
  1046     ^ aField
   909 !
  1047 !
   910 
  1048 
   911 addInputField:aField
  1049 addInputField:aField
   912     "add an already created input field; return the field.
  1050     "add an already created input field; return the field.
   913      Returns the field."
  1051      Returns the field."
   914 
  1052 
   915     self addComponent:aField.
  1053     ^ self addInputField:aField tabable:true
   916     inputFieldGroup isNil ifTrue:[
  1054 !
   917 	inputFieldGroup := EnterFieldGroup new.
  1055 
   918 	inputFieldGroup leaveAction:[accepted := true. self okPressed].
  1056 addInputFieldOn:aModel tabable:tabable
   919 	aField hasKeyboardFocus:true.
  1057     "create an input field on aModel and add it.
   920     ].
  1058      Returns the field."
   921     inputFieldGroup add:aField.
  1059 
   922     self delegate:(KeyboardForwarder to:inputFieldGroup condition:#noFocus).
  1060     |f|
   923     ^ aField
  1061 
       
  1062     f := EditField new.
       
  1063     f model:aModel.
       
  1064     self addInputField:f tabable:tabable.
       
  1065     ^ f
   924 !
  1066 !
   925 
  1067 
   926 addInputFieldOn:aModel
  1068 addInputFieldOn:aModel
   927     "create an input field on aModel and add it.
  1069     "create an input field on aModel and add it.
   928      Returns the field."
  1070      Returns the field."
   929 
  1071 
   930     |f|
  1072     ^ self addInputFieldOn:aModel tabable:true
   931 
  1073 
   932     f := EditField new.
  1074     "
   933     f model:aModel.
  1075      |dialog model field|
   934     self addInputField:f.
       
   935     ^ f
       
   936 
       
   937     "
       
   938      |dialog model field ok|
       
   939 
  1076 
   940      model := '' asValue.
  1077      model := '' asValue.
   941 
  1078 
   942      dialog := DialogBox new.
  1079      dialog := DialogBox new.
   943      dialog addTextLabel:'enter a string'.
  1080      dialog addTextLabel:'enter a string'.
   944      field := dialog addInputFieldOn:model.
  1081      field := dialog addInputFieldOn:model.
   945      dialog addAbortButton; addOkButton:[field accept. ok := true].
  1082      dialog addAbortButton; addOkButton.
   946      ok := false.
       
   947      dialog open.
  1083      dialog open.
   948      ok ifTrue:[Transcript showCr:model value].
  1084      dialog accepted ifTrue:[Transcript showCr:model value].
   949     "
  1085     "
   950 !
  1086 !
   951 
  1087 
   952 addVerticalSpace
  1088 addVerticalSpace
   953     "add a default vertical space (1 mm)"
  1089     "add a default vertical space (1 mm)"
   993     accepted := false.
  1129     accepted := false.
   994 
  1130 
   995     mm := ViewSpacing.
  1131     mm := ViewSpacing.
   996 
  1132 
   997     acceptReturnAsOK := true.
  1133     acceptReturnAsOK := true.
       
  1134     acceptOnLeave := true.
   998 
  1135 
   999     buttonPanel := HorizontalPanelView in:self.
  1136     buttonPanel := HorizontalPanelView in:self.
  1000     buttonPanel 
  1137     buttonPanel 
  1001 	origin:(0.0 @ 1.0) corner:(1.0 @ 1.0);
  1138 	origin:(0.0 @ 1.0) corner:(1.0 @ 1.0);
  1002 	bottomInset:mm; 
  1139 	bottomInset:mm; 
  1036        showAtPointer
  1173        showAtPointer
  1037     "
  1174     "
  1038 !
  1175 !
  1039 
  1176 
  1040 focusSequence
  1177 focusSequence
  1041     ^ buttonPanel subViews
  1178     "return the elements through which we can step via 
       
  1179      NextField/PreviousField keys.
       
  1180      Here we return all tabable fields followed by all buttons in
       
  1181      the panel."
       
  1182 
       
  1183     |fields buttons|
       
  1184 
       
  1185     tabableElements isNil ifTrue:[
       
  1186 	fields := #()
       
  1187     ] ifFalse:[
       
  1188 	fields := tabableElements
       
  1189     ].
       
  1190     buttonPanel notNil ifTrue:[
       
  1191 	buttons := buttonPanel subViews.
       
  1192 	buttons notNil ifTrue:[
       
  1193 	    fields := fields , buttonPanel subViews
       
  1194 	]
       
  1195     ].
       
  1196     ^ fields
  1042 !
  1197 !
  1043 
  1198 
  1044 reAdjustGeometry
  1199 reAdjustGeometry
  1045     "sent late in snapin processing - gives me a chance
  1200     "sent late in snapin processing - gives me a chance
  1046      to resize for changed font dimensions."
  1201      to resize for changed font dimensions."
  1052 ! !
  1207 ! !
  1053 
  1208 
  1054 !DialogBox methodsFor:'queries'!
  1209 !DialogBox methodsFor:'queries'!
  1055 
  1210 
  1056 accepted
  1211 accepted
       
  1212     "after the box has closed: return true if accepted,
       
  1213      false if canceled"
       
  1214 
  1057     ^ accepted
  1215     ^ accepted
  1058 !
  1216 !
  1059 
  1217 
  1060 positionOffset
  1218 positionOffset
  1061     "return the delta, by which the box should be displayed
  1219     "return the delta, by which the box should be displayed