254 treeView askForSelectionChangeAllowed ifFalse:[^ self]. |
254 treeView askForSelectionChangeAllowed ifFalse:[^ self]. |
255 |
255 |
256 coll := self minSetOfSuperViews:(self selection). |
256 coll := self minSetOfSuperViews:(self selection). |
257 |
257 |
258 coll notNil ifTrue:[ |
258 coll notNil ifTrue:[ |
259 treeView cvsEventsDisabledDo:[ |
259 treeView cvsEventsDisabledDo:[ |
260 treeModel := treeView model. |
260 treeModel := treeView model. |
261 oldSelection := treeModel selectedNodes at:1 ifAbsent: nil. |
261 oldSelection := treeModel selectedNodes at:1 ifAbsent: nil. |
262 |
262 |
263 oldSelection notNil ifTrue:[ |
263 oldSelection notNil ifTrue:[ |
264 children := oldSelection parent children. |
264 children := oldSelection parent children. |
265 (size := children size) > 1 ifTrue:[ |
265 (size := children size) > 1 ifTrue:[ |
266 index := children identityIndexOf:oldSelection. |
266 index := children identityIndexOf:oldSelection. |
267 size == index ifTrue:[ |
267 size == index ifTrue:[ |
268 index := index - 1 |
268 index := index - 1 |
269 ]. |
269 ]. |
270 newSelection := children at:index ifAbsent:1. |
270 newSelection := children at:index ifAbsent:1. |
271 ] ifFalse:[ |
271 ] ifFalse:[ |
272 newSelection := oldSelection parent |
272 newSelection := oldSelection parent |
273 ]. |
273 ]. |
274 newSelection := treeModel indexOf:newSelection. |
274 newSelection := treeModel indexOf:newSelection. |
275 ] ifFalse:[ |
275 ] ifFalse:[ |
276 newSelection := 1 |
276 newSelection := 1 |
277 ]. |
277 ]. |
278 |
278 |
279 self hideSelection. |
279 self hideSelection. |
280 selection := nil. |
280 selection := nil. |
281 specs := coll collect:[:aView| self fullSpecFor:aView ]. |
281 specs := coll collect:[:aView| self fullSpecFor:aView ]. |
282 |
282 |
283 self withinTransaction:#cut objects:coll do:[ |
283 self withinTransaction:#cut objects:coll do:[ |
284 coll reverseDo:[:aView| |
284 coll reverseDo:[:aView| |
285 self createUndoRemove:aView. |
285 self createUndoRemove:aView. |
286 self remove:aView. |
286 self remove:aView. |
287 ] |
287 ] |
288 ]. |
288 ]. |
289 buffered ifTrue: [self setSelection:specs]. |
289 buffered ifTrue: [self setSelection:specs]. |
290 treeView selection:nil. |
290 treeView selection:nil. |
291 treeView selection:(Array with: newSelection). |
291 treeView selection:(Array with: newSelection). |
292 (nd := treeView selectedNode) notNil ifTrue:[ |
292 (nd := treeView selectedNode) notNil ifTrue:[ |
293 self setSelection:nd contents view withRedraw:true. |
293 self setSelection:nd contents view withRedraw:true. |
294 ] |
294 ] |
295 ] |
295 ] |
296 ] |
296 ] |
297 ! |
297 ! |
298 |
298 |
299 deleteTotalSelection |
299 deleteTotalSelection |
300 "delete the selection |
300 "delete the selection |
301 " |
301 " |
302 self deleteSelectionBuffered: false |
302 self deleteSelectionBuffered: false |
303 ! |
303 ! |
304 |
304 |
305 getSelectedViewsAndSpecs |
305 getSelectedViewsAndSpecs |
306 "return an array filed with selected views and corresponding specs. |
306 "return an array filed with selected views and corresponding specs. |
385 |
385 |
386 treeView askForSelectionChangeAllowed ifFalse:[^ nil]. |
386 treeView askForSelectionChangeAllowed ifFalse:[^ nil]. |
387 |
387 |
388 containerToPasteInto := self singleSelection. |
388 containerToPasteInto := self singleSelection. |
389 containerToPasteInto isNil ifTrue:[ |
389 containerToPasteInto isNil ifTrue:[ |
390 self selection size > 0 ifTrue:[ |
390 self selection size > 0 ifTrue:[ |
391 containerToPasteInto := self commonContainerOf:self selection |
391 containerToPasteInto := self commonContainerOf:self selection |
392 ] ifFalse:[ |
392 ] ifFalse:[ |
393 containerToPasteInto := self |
393 containerToPasteInto := self |
394 ]. |
394 ]. |
395 self selection:containerToPasteInto. |
395 self selection:containerToPasteInto. |
396 ]. |
396 ]. |
397 |
397 |
398 (self canPasteInto:containerToPasteInto) ifFalse:[ |
398 (self canPasteInto:containerToPasteInto) ifFalse:[ |
399 containerToPasteInto notNil ifTrue:[ |
399 containerToPasteInto notNil ifTrue:[ |
400 "/ search up parent list for something we can paste into |
400 "/ search up parent list for something we can paste into |
401 [containerToPasteInto notNil and:[(self canPasteInto:containerToPasteInto) not]] whileTrue:[ |
401 [containerToPasteInto notNil and:[(self canPasteInto:containerToPasteInto) not]] whileTrue:[ |
402 containerToPasteInto := containerToPasteInto container. |
402 containerToPasteInto := containerToPasteInto container. |
403 ]. |
403 ]. |
404 self selection:containerToPasteInto. |
404 self selection:containerToPasteInto. |
405 ]. |
405 ]. |
406 ]. |
406 ]. |
407 containerToPasteInto isNil ifTrue:[ |
407 containerToPasteInto isNil ifTrue:[ |
408 containerToPasteInto := self |
408 containerToPasteInto := self |
409 ]. |
409 ]. |
410 |
410 |
411 (self canPaste:aSpecificationOrList) ifFalse:[ |
411 (self canPaste:aSpecificationOrList) ifFalse:[ |
412 Dialog warn:'Cannot paste into selected component (not a container ?)'. |
412 Dialog warn:'Cannot paste into selected component (not a container ?)'. |
413 ^ nil |
413 ^ nil |
414 ]. |
414 ]. |
415 |
415 |
416 aSpecificationOrList isCollection ifTrue:[ |
416 aSpecificationOrList isCollection ifTrue:[ |
417 paste := aSpecificationOrList |
417 paste := aSpecificationOrList |
418 ] ifFalse:[ |
418 ] ifFalse:[ |
419 paste := Array with:aSpecificationOrList |
419 paste := Array with:aSpecificationOrList |
420 ]. |
420 ]. |
421 self setSelection:nil. |
421 self setSelection:nil. |
422 |
422 |
423 newSel := OrderedCollection new. |
423 newSel := OrderedCollection new. |
424 builder := UIBuilder new isEditing:true. |
424 builder := UIBuilder new isEditing:true. |
425 |
425 |
426 className notNil ifTrue:[ |
426 className notNil ifTrue:[ |
427 builder applicationClass:(self resolveName:className) |
427 builder applicationClass:(self resolveName:className) |
428 ]. |
428 ]. |
429 |
429 |
430 (keepLayout not or:[keepPosition]) ifTrue:[ |
430 (keepLayout not or:[keepPosition]) ifTrue:[ |
431 pasteOffset := 0@0. |
431 pasteOffset := 0@0. |
432 |
432 |
433 keepPosition ifTrue:[ |
433 keepPosition ifTrue:[ |
434 pasteOrigin := device translatePoint:0@0 |
434 pasteOrigin := device translatePoint:0@0 |
435 fromView:self |
435 fromView:self |
436 toView:containerToPasteInto. |
436 toView:containerToPasteInto. |
437 ] ifFalse:[ |
437 ] ifFalse:[ |
438 aPointOrNil isNil ifTrue:[ |
438 aPointOrNil isNil ifTrue:[ |
439 pasteOrigin := self sensor mousePoint. |
439 pasteOrigin := self sensor mousePoint. |
440 pasteOrigin := device translatePoint:pasteOrigin |
440 pasteOrigin := device translatePoint:pasteOrigin |
441 fromView:nil |
441 fromView:nil |
442 toView:containerToPasteInto. |
442 toView:containerToPasteInto. |
443 ] ifFalse:[ |
443 ] ifFalse:[ |
444 pasteOrigin := device translatePoint:aPointOrNil |
444 pasteOrigin := device translatePoint:aPointOrNil |
445 fromView:self |
445 fromView:self |
446 toView:containerToPasteInto. |
446 toView:containerToPasteInto. |
447 ] |
447 ] |
448 ]. |
448 ]. |
449 |
449 |
450 bounds := Rectangle origin:0@0 extent:(containerToPasteInto bounds extent) |
450 bounds := Rectangle origin:0@0 extent:(containerToPasteInto bounds extent) |
451 ]. |
451 ]. |
452 |
452 |
453 paste do:[:aSpec| |
453 paste do:[:aSpec| |
454 |view newOrigin| |
454 |view newOrigin| |
455 |
455 |
456 view := self addSpec:aSpec builder:builder in:containerToPasteInto. |
456 view := self addSpec:aSpec builder:builder in:containerToPasteInto. |
457 |
457 |
458 keepPosition ifTrue:[ |
458 keepPosition ifTrue:[ |
459 self moveObject:view to:(view origin + pasteOrigin). |
459 self moveObject:view to:(view origin + pasteOrigin). |
460 ] ifFalse:[ |
460 ] ifFalse:[ |
461 keepLayout ifFalse:[ |
461 keepLayout ifFalse:[ |
462 (bounds containsPoint:pasteOrigin) ifFalse:[ |
462 (bounds containsPoint:pasteOrigin) ifFalse:[ |
463 newOrigin := pasteOffset. |
463 newOrigin := pasteOffset. |
464 ] ifTrue:[ |
464 ] ifTrue:[ |
465 newOrigin := pasteOrigin + pasteOffset. |
465 newOrigin := pasteOrigin + pasteOffset. |
466 ]. |
466 ]. |
467 self moveObject:view to:newOrigin. |
467 self moveObject:view to:newOrigin. |
468 pasteOffset := pasteOffset + 4 |
468 pasteOffset := pasteOffset + 4 |
469 ]. |
469 ]. |
470 ]. |
470 ]. |
471 view realize. |
471 view realize. |
472 newSel add:view. |
472 newSel add:view. |
473 ]. |
473 ]. |
474 |
474 |
475 self withinTransaction:#paste objects:newSel do:[ |
475 self withinTransaction:#paste objects:newSel do:[ |
476 undoHistory addUndoSelector:#undoCreate: |
476 undoHistory addUndoSelector:#undoCreate: |
477 withArgs:(newSel collect:[:v|(self propertyOfView:v) identifier]) |
477 withArgs:(newSel collect:[:v|(self propertyOfView:v) identifier]) |
478 ]. |
478 ]. |
479 |
479 |
480 self realizeAllSubViews. |
480 self realizeAllSubViews. |
481 newSel do:[:v| v raise]. |
481 newSel do:[:v| v raise]. |
482 self elementChangedSize:containerToPasteInto. |
482 self elementChangedSize:containerToPasteInto. |
652 "evaluate aBlock for every aspect methods selector; 2nd arg describes the aspects type" |
652 "evaluate aBlock for every aspect methods selector; 2nd arg describes the aspects type" |
653 |
653 |
654 |cls selector protoSpec| |
654 |cls selector protoSpec| |
655 |
655 |
656 className isNil ifTrue:[ |
656 className isNil ifTrue:[ |
657 self warn:'No class defined !!'. |
657 self warn:'No class defined !!'. |
658 ^ self |
658 ^ self |
659 ]. |
659 ]. |
660 |
660 |
661 cls := self resolveName:className. |
661 cls := self resolveName:className. |
662 |
662 |
663 treeView propertiesDo:[:aProp| |
663 treeView propertiesDo:[:aProp| |
664 |selector| |
664 |selector| |
665 |
665 |
666 (selector := aProp model) notNil ifTrue:[ |
666 (selector := aProp model) notNil ifTrue:[ |
667 selector isArray ifFalse:[ |
667 selector isArray ifFalse:[ |
668 aTwoArgBlock value:(selector asSymbol) value:#modelAspect |
668 aTwoArgBlock value:(selector asSymbol) value:#modelAspect |
669 ]. |
669 ]. |
670 ]. |
670 ]. |
671 |
671 |
672 (selector := aProp menu) notNil ifTrue:[ |
672 (selector := aProp menu) notNil ifTrue:[ |
673 selector isArray ifFalse:[ |
673 selector isArray ifFalse:[ |
674 aTwoArgBlock value:(selector asSymbol) value:#menu |
674 aTwoArgBlock value:(selector asSymbol) value:#menu |
675 ]. |
675 ]. |
676 ]. |
676 ]. |
677 |
677 |
678 (aProp spec aspectSelectors) do:[:aSel | |
678 (aProp spec aspectSelectors) do:[:aSel | |
679 aSel isArray ifFalse:[ |
679 aSel isArray ifFalse:[ |
680 aTwoArgBlock value:(aSel asSymbol) value:#channelAspect |
680 aTwoArgBlock value:(aSel asSymbol) value:#channelAspect |
681 ]. |
681 ]. |
682 ]. |
682 ]. |
683 aProp spec actionSelectors do:[:aSel| |
683 aProp spec actionSelectors do:[:aSel| |
684 aSel isArray ifFalse:[ |
684 aSel isArray ifFalse:[ |
685 aTwoArgBlock value:(aSel asSymbol) value:#actionSelector |
685 aTwoArgBlock value:(aSel asSymbol) value:#actionSelector |
686 ]. |
686 ]. |
687 ]. |
687 ]. |
688 aProp spec valueSelectors do:[:aSel| |
688 aProp spec valueSelectors do:[:aSel| |
689 aSel isArray ifFalse:[ |
689 aSel isArray ifFalse:[ |
690 aTwoArgBlock value:(aSel asSymbol) value:#valueSelector |
690 aTwoArgBlock value:(aSel asSymbol) value:#valueSelector |
691 ]. |
691 ]. |
692 ] |
692 ] |
693 ]. |
693 ]. |
694 |
694 |
695 protoSpec := treeView canvasSpec. |
695 protoSpec := treeView canvasSpec. |
696 |
696 |
697 (selector := protoSpec menu) notNil ifTrue:[ |
697 (selector := protoSpec menu) notNil ifTrue:[ |
698 selector isArray ifFalse:[ |
698 selector isArray ifFalse:[ |
699 aTwoArgBlock value:(selector asSymbol) value:#menu |
699 aTwoArgBlock value:(selector asSymbol) value:#menu |
700 ]. |
700 ]. |
701 ]. |
701 ]. |
702 ! |
702 ! |
703 |
703 |
704 generateActionMethodFor:aspect spec:protoSpec inClass:targetClass |
704 generateActionMethodFor:aspect spec:protoSpec inClass:targetClass |
705 |selector args showIt code alreadyInSuperclass numArgs method| |
705 |selector args showIt code alreadyInSuperclass numArgs method| |
710 |
710 |
711 numArgs := selector numArgs. |
711 numArgs := selector numArgs. |
712 method := aspect. |
712 method := aspect. |
713 |
713 |
714 numArgs == 1 ifTrue:[ |
714 numArgs == 1 ifTrue:[ |
715 args := 'anArgument'. |
715 args := 'anArgument'. |
716 showIt := ''' , anArgument printString , '' ...''.\'. |
716 showIt := ''' , anArgument printString , '' ...''.\'. |
717 ] ifFalse:[ |
717 ] ifFalse:[ |
718 args := ''. |
718 args := ''. |
719 showIt := ' ...''.\'. |
719 showIt := ' ...''.\'. |
720 |
720 |
721 numArgs ~~ 0 ifTrue:[ |
721 numArgs ~~ 0 ifTrue:[ |
722 method := ''. |
722 method := ''. |
723 |
723 |
724 selector keywords keysAndValuesDo:[:i :key| |
724 selector keywords keysAndValuesDo:[:i :key| |
725 method := method, key, 'arg', i printString, ' ' |
725 method := method, key, 'arg', i printString, ' ' |
726 ] |
726 ] |
727 ] |
727 ] |
728 ]. |
728 ]. |
729 |
729 |
730 code := '!!' , targetClass name , ' methodsFor:''actions''!!\\' , |
730 code := '!!' , targetClass name , ' methodsFor:''actions''!!\\' , |
731 method , args , '\' , |
731 method , args , '\' , |
732 ' "automatically generated by UIPainter ..."\\' , |
732 ' "automatically generated by UIPainter ..."\\' , |
733 ' "*** the code below performs no action"\' , |
733 ' "*** the code below performs no action"\' , |
734 ' "*** (except for some feedback on the Transcript)"\' , |
734 ' "*** (except for some feedback on the Transcript)"\' , |
735 ' "*** Please change as required and accept in the browser."\' , |
735 ' "*** Please change as required and accept in the browser."\' , |
736 '\' . |
736 '\' . |
737 |
737 |
738 alreadyInSuperclass ifTrue:[ |
738 alreadyInSuperclass ifTrue:[ |
739 code := code , |
739 code := code , |
740 ' "action for ' , aspect , ' is already provided in a superclass."\' , |
740 ' "action for ' , aspect , ' is already provided in a superclass."\' , |
741 ' "It may be redefined here ..."\\'. |
741 ' "It may be redefined here ..."\\'. |
742 ] ifFalse:[ |
742 ] ifFalse:[ |
743 code := code , |
743 code := code , |
744 ' "action to be added ..."\\'. |
744 ' "action to be added ..."\\'. |
745 ]. |
745 ]. |
746 |
746 |
747 code := code , |
747 code := code , |
748 ' Transcript showCR:self class name, '': '. |
748 ' Transcript showCR:self class name, '': '. |
749 alreadyInSuperclass ifTrue:[ |
749 alreadyInSuperclass ifTrue:[ |
750 code := code , 'inherited '. |
750 code := code , 'inherited '. |
751 ]. |
751 ]. |
752 code := code , 'action for ' , aspect , showIt. |
752 code := code , 'action for ' , aspect , showIt. |
753 |
753 |
754 alreadyInSuperclass ifTrue:[ |
754 alreadyInSuperclass ifTrue:[ |
755 code := code , |
755 code := code , |
756 ' super ' , aspect , args , '.\'. |
756 ' super ' , aspect , args , '.\'. |
757 ]. |
757 ]. |
758 |
758 |
759 code := code , |
759 code := code , |
760 '!! !!\\'. |
760 '!! !!\\'. |
761 ^ code withCRs |
761 ^ code withCRs |
762 |
762 |
763 "Modified: / 25.10.1997 / 19:18:50 / cg" |
763 "Modified: / 25.10.1997 / 19:18:50 / cg" |
764 ! |
764 ! |
765 |
765 |
779 |cls codePieces skip protoSpec thisCode |
779 |cls codePieces skip protoSpec thisCode |
780 definedMethodSelectors iVars t exportSels| |
780 definedMethodSelectors iVars t exportSels| |
781 |
781 |
782 cls := self targetClass. |
782 cls := self targetClass. |
783 cls isNil ifTrue:[ |
783 cls isNil ifTrue:[ |
784 ^ nil |
784 ^ nil |
785 ]. |
785 ]. |
786 |
786 |
787 codePieces := OrderedCollection new. |
787 codePieces := OrderedCollection new. |
788 definedMethodSelectors := IdentitySet new. |
788 definedMethodSelectors := IdentitySet new. |
789 |
789 |
790 treeView propertiesDo:[:aProp| |
790 treeView propertiesDo:[:aProp| |
791 |modelSelector| |
791 |modelSelector| |
792 |
792 |
793 protoSpec := aProp spec. |
793 protoSpec := aProp spec. |
794 |
794 |
795 (modelSelector := aProp model) notNil ifTrue:[ |
795 (modelSelector := aProp model) notNil ifTrue:[ |
796 self generateCodeFrom:(Array with:modelSelector) in:cls |
796 self generateCodeFrom:(Array with:modelSelector) in:cls |
797 do:[:aSel| |
797 do:[:aSel| |
798 (aFilterOrEmpty isNil or:[aFilterOrEmpty includes:aSel]) ifTrue:[ |
798 (aFilterOrEmpty isNil or:[aFilterOrEmpty includes:aSel]) ifTrue:[ |
799 skip := false. |
799 skip := false. |
800 |
800 |
801 (cls isSubclassOf:SimpleDialog) ifTrue:[ |
801 (cls isSubclassOf:SimpleDialog) ifTrue:[ |
802 skip := SimpleDialog includesSelector:aSel |
802 skip := SimpleDialog includesSelector:aSel |
803 ]. |
803 ]. |
804 (definedMethodSelectors includes:aSel) ifTrue:[ |
804 (definedMethodSelectors includes:aSel) ifTrue:[ |
805 skip := true. |
805 skip := true. |
806 ]. |
806 ]. |
807 |
807 |
808 skip ifFalse:[ |
808 skip ifFalse:[ |
809 "/ kludge .. |
809 "/ kludge .. |
810 "/ (protoSpec isKindOf:ActionButtonSpec) |
810 "/ (protoSpec isKindOf:ActionButtonSpec) |
811 (protoSpec defaultModelIsCallBackMethodSelector:aSel) |
811 (protoSpec defaultModelIsCallBackMethodSelector:aSel) |
812 ifTrue:[ |
812 ifTrue:[ |
813 thisCode := (self generateActionMethodFor:aSel spec:protoSpec inClass:cls). |
813 thisCode := (self generateActionMethodFor:aSel spec:protoSpec inClass:cls). |
814 ] ifFalse:[ |
814 ] ifFalse:[ |
815 thisCode := (self generateAspectMethodFor:aSel spec:protoSpec inClass:cls). |
815 thisCode := (self generateAspectMethodFor:aSel spec:protoSpec inClass:cls). |
816 ]. |
816 ]. |
817 codePieces add:thisCode. |
817 codePieces add:thisCode. |
818 definedMethodSelectors add:aSel. |
818 definedMethodSelectors add:aSel. |
819 Transcript showCR:'code generated for aspect: ' , aSel |
819 Transcript showCR:'code generated for aspect: ' , aSel |
820 ] ifTrue:[ |
820 ] ifTrue:[ |
821 Transcript showCR:'*** no code generated for aspect: ' , aSel , ' (method already exists)' |
821 Transcript showCR:'*** no code generated for aspect: ' , aSel , ' (method already exists)' |
822 ]. |
822 ]. |
823 ]. |
823 ]. |
824 ]. |
824 ]. |
825 ]. |
825 ]. |
826 |
826 |
827 "/ for each aspect, generate getter (if not yet implemented) |
827 "/ for each aspect, generate getter (if not yet implemented) |
828 self generateCodeFrom:(aProp spec aspectSelectors) in:cls |
828 self generateCodeFrom:(aProp spec aspectSelectors) in:cls |
829 do:[:aSel| |
829 do:[:aSel| |
830 (aFilterOrEmpty isNil or:[aFilterOrEmpty includes:aSel]) ifTrue:[ |
830 (aFilterOrEmpty isNil or:[aFilterOrEmpty includes:aSel]) ifTrue:[ |
831 (definedMethodSelectors includes:aSel) ifFalse:[ |
831 (definedMethodSelectors includes:aSel) ifFalse:[ |
832 thisCode := (self generateAspectMethodFor:aSel spec:protoSpec inClass:cls). |
832 thisCode := (self generateAspectMethodFor:aSel spec:protoSpec inClass:cls). |
833 codePieces add:thisCode. |
833 codePieces add:thisCode. |
834 definedMethodSelectors add:aSel. |
834 definedMethodSelectors add:aSel. |
835 Transcript showCR:'code generated for aspect: ' , aSel |
835 Transcript showCR:'code generated for aspect: ' , aSel |
836 ] |
836 ] |
837 ] |
837 ] |
838 ]. |
838 ]. |
839 |
839 |
840 "/ exported aspects - need setter methods |
840 "/ exported aspects - need setter methods |
841 exportSels := (treeView exportedAspects ? #()) collect:[:entry | (entry subAspect , ':') asSymbol]. |
841 exportSels := (treeView exportedAspects ? #()) collect:[:entry | (entry subAspect , ':') asSymbol]. |
842 self generateCodeFrom:exportSels in:cls |
842 self generateCodeFrom:exportSels in:cls |
843 do:[:aSel| |
843 do:[:aSel| |
844 |aspect| |
844 |aspect| |
845 |
845 |
846 (aFilterOrEmpty isNil or:[aFilterOrEmpty includes:aSel]) ifTrue:[ |
846 (aFilterOrEmpty isNil or:[aFilterOrEmpty includes:aSel]) ifTrue:[ |
847 (definedMethodSelectors includes:aSel) ifFalse:[ |
847 (definedMethodSelectors includes:aSel) ifFalse:[ |
848 aspect := (aSel copyWithoutLast:1) asSymbol. |
848 aspect := (aSel copyWithoutLast:1) asSymbol. |
849 thisCode := (self generateAspectSetMethodFor:aspect spec:protoSpec inClass:cls). |
849 thisCode := (self generateAspectSetMethodFor:aspect spec:protoSpec inClass:cls). |
850 codePieces add:thisCode. |
850 codePieces add:thisCode. |
851 definedMethodSelectors add:aSel. |
851 definedMethodSelectors add:aSel. |
852 Transcript showCR:'export code generated for aspect: ' , aSel |
852 Transcript showCR:'export code generated for aspect: ' , aSel |
853 ] |
853 ] |
854 ] |
854 ] |
855 ]. |
855 ]. |
856 |
856 |
857 self generateCodeFrom:(aProp spec actionSelectors) in:cls |
857 self generateCodeFrom:(aProp spec actionSelectors) in:cls |
858 do:[:aSel| |
858 do:[:aSel| |
859 (aFilterOrEmpty isNil or:[aFilterOrEmpty includes:aSel]) ifTrue:[ |
859 (aFilterOrEmpty isNil or:[aFilterOrEmpty includes:aSel]) ifTrue:[ |
860 (definedMethodSelectors includes:aSel) ifFalse:[ |
860 (definedMethodSelectors includes:aSel) ifFalse:[ |
861 thisCode := (self generateActionMethodFor:aSel spec:protoSpec inClass:cls). |
861 thisCode := (self generateActionMethodFor:aSel spec:protoSpec inClass:cls). |
862 codePieces add:thisCode. |
862 codePieces add:thisCode. |
863 definedMethodSelectors add:aSel. |
863 definedMethodSelectors add:aSel. |
864 Transcript showCR:'action generated for aspect: ' , aSel |
864 Transcript showCR:'action generated for aspect: ' , aSel |
865 ] |
865 ] |
866 ] |
866 ] |
867 ]. |
867 ]. |
868 |
868 |
869 self generateCodeFrom:(aProp spec valueSelectors) in:cls |
869 self generateCodeFrom:(aProp spec valueSelectors) in:cls |
870 do:[:aSel| |
870 do:[:aSel| |
871 (aFilterOrEmpty isNil or:[aFilterOrEmpty includes:aSel]) ifTrue:[ |
871 (aFilterOrEmpty isNil or:[aFilterOrEmpty includes:aSel]) ifTrue:[ |
872 (definedMethodSelectors includes:aSel) ifFalse:[ |
872 (definedMethodSelectors includes:aSel) ifFalse:[ |
873 "/ uppercase: - assume its a globals name. |
873 "/ uppercase: - assume its a globals name. |
874 aSel first isUppercase ifFalse:[ |
874 aSel first isUppercase ifFalse:[ |
875 thisCode := (self generateValueMethodFor:aSel spec:protoSpec inClass:cls). |
875 thisCode := (self generateValueMethodFor:aSel spec:protoSpec inClass:cls). |
876 codePieces add:thisCode. |
876 codePieces add:thisCode. |
877 definedMethodSelectors add:aSel. |
877 definedMethodSelectors add:aSel. |
878 Transcript showCR:'code generated for aspect: ' , aSel |
878 Transcript showCR:'code generated for aspect: ' , aSel |
879 ] |
879 ] |
880 ] |
880 ] |
881 ] |
881 ] |
882 ]. |
882 ]. |
883 ]. |
883 ]. |
884 |
884 |
885 AspectsAsInstances ifTrue:[ |
885 AspectsAsInstances ifTrue:[ |
886 iVars := cls instVarNames asOrderedCollection. |
886 iVars := cls instVarNames asOrderedCollection. |
887 definedMethodSelectors do:[:ivar | |
887 definedMethodSelectors do:[:ivar | |
888 (iVars includes:ivar) ifFalse:[ |
888 (iVars includes:ivar) ifFalse:[ |
889 iVars add:ivar |
889 iVars add:ivar |
890 ] |
890 ] |
891 ]. |
891 ]. |
892 iVars := iVars asArray. |
892 iVars := iVars asArray. |
893 t := cls shallowCopy. |
893 t := cls shallowCopy. |
894 t setInstanceVariableString:iVars asStringCollection asString. |
894 t setInstanceVariableString:iVars asStringCollection asString. |
895 codePieces addFirst:(t definition , '!!\' withCRs). |
895 codePieces addFirst:(t definition , '!!\' withCRs). |
896 ]. |
896 ]. |
897 |
897 |
898 ^ String |
898 ^ String |
899 streamContents: |
899 streamContents: |
900 [:codeStream | |
900 [:codeStream | |
901 codePieces do:[:eachPiece | codeStream nextPutAll:eachPiece]. |
901 codePieces do:[:eachPiece | codeStream nextPutAll:eachPiece]. |
902 ]. |
902 ]. |
903 |
903 |
904 "Modified: / 29.7.1998 / 12:21:19 / cg" |
904 "Modified: / 29.7.1998 / 12:21:19 / cg" |
905 ! |
905 ! |
906 |
906 |
907 generateAspectMethodFor:aspect spec:protoSpec inClass:targetClass |
907 generateAspectMethodFor:aspect spec:protoSpec inClass:targetClass |
908 |modelClass modelValueString modelValue modelGen code| |
908 |modelClass modelValueString modelValue modelGen code| |
909 |
909 |
910 modelClass := protoSpec defaultModelClassFor:aspect. |
910 modelClass := protoSpec defaultModelClassFor:aspect. |
911 modelValueString := protoSpec defaultModelValueStringFor:aspect. |
911 modelValueString := protoSpec defaultModelValueStringFor:aspect. |
912 modelValueString notNil ifTrue:[ |
912 modelValueString notNil ifTrue:[ |
913 modelGen := modelValueString |
913 modelGen := modelValueString |
914 ] ifFalse:[ |
914 ] ifFalse:[ |
915 modelValue := protoSpec defaultModelValueFor:aspect. |
915 modelValue := protoSpec defaultModelValueFor:aspect. |
916 modelValue isNil ifTrue:[ |
916 modelValue isNil ifTrue:[ |
917 modelGen := modelClass name , ' new' |
917 modelGen := modelClass name , ' new' |
918 ] ifFalse:[ |
918 ] ifFalse:[ |
919 modelGen := modelValue storeString , ' asValue' |
919 modelGen := modelValue storeString , ' asValue' |
920 ]. |
920 ]. |
921 |
921 |
922 ]. |
922 ]. |
923 |
923 |
924 code := '!!' , targetClass name , ' methodsFor:''aspects''!!\\' , |
924 code := '!!' , targetClass name , ' methodsFor:''aspects''!!\\' , |
925 aspect , '\' , |
925 aspect , '\' , |
929 ' "*** Please change as required and accept it in the browser."\' , |
929 ' "*** Please change as required and accept it in the browser."\' , |
930 ' "*** (and replace this comment by something more useful ;-)"\' . |
930 ' "*** (and replace this comment by something more useful ;-)"\' . |
931 |
931 |
932 |
932 |
933 AspectsAsInstances ifTrue:[ |
933 AspectsAsInstances ifTrue:[ |
934 code := code , '\' , |
934 code := code , '\' , |
935 ' ' , aspect , ' isNil ifTrue:[\' , |
935 ' ' , aspect , ' isNil ifTrue:[\' , |
936 ' ' , aspect , ' := ' , modelGen , '.\'. |
936 ' ' , aspect , ' := ' , modelGen , '.\'. |
937 modelClass ~~ TriggerValue ifTrue:[ |
937 modelClass ~~ TriggerValue ifTrue:[ |
938 code := code , |
938 code := code , |
939 '"/ if your app needs to be notified of changes, uncomment one of the lines below:\' , |
939 '"/ if your app needs to be notified of changes, uncomment one of the lines below:\' , |
940 '"/ ' , aspect , ' addDependent:self.\' , |
940 '"/ ' , aspect , ' addDependent:self.\' , |
941 '"/ ' , aspect , ' onChangeSend:#', aspect ,'Changed to:self.\'. |
941 '"/ ' , aspect , ' onChangeSend:#', aspect ,'Changed to:self.\'. |
942 ]. |
942 ]. |
943 code := code , |
943 code := code , |
944 ' ].\' , |
944 ' ].\' , |
945 ' ^ ' , aspect ,'.\' , |
945 ' ^ ' , aspect ,'.\' , |
946 '!! !!\\' |
946 '!! !!\\' |
947 ] ifFalse:[ |
947 ] ifFalse:[ |
948 code := code , '\' , |
948 code := code , '\' , |
949 ' |holder|\' , |
949 ' |holder|\' , |
950 '\' , |
950 '\' , |
951 ' (holder := builder bindingAt:#' , aspect , ') isNil ifTrue:[\' , |
951 ' (holder := builder bindingAt:#' , aspect , ') isNil ifTrue:[\' , |
952 ' holder := ', modelGen, '.\', |
952 ' holder := ', modelGen, '.\', |
953 ' builder aspectAt:#' , aspect , ' put:holder.\'. |
953 ' builder aspectAt:#' , aspect , ' put:holder.\'. |
954 modelClass ~~ TriggerValue ifTrue:[ |
954 modelClass ~~ TriggerValue ifTrue:[ |
955 code := code , |
955 code := code , |
956 '"/ if your app needs to be notified of changes, uncomment one of the lines below:\' , |
956 '"/ if your app needs to be notified of changes, uncomment one of the lines below:\' , |
957 '"/ holder addDependent:self.\' , |
957 '"/ holder addDependent:self.\' , |
958 '"/ holder onChangeSend:#', aspect ,'Changed to:self.\'. |
958 '"/ holder onChangeSend:#', aspect ,'Changed to:self.\'. |
959 ]. |
959 ]. |
960 code := code , |
960 code := code , |
961 ' ].\' , |
961 ' ].\' , |
962 ' ^ holder.\' , |
962 ' ^ holder.\' , |
963 '!! !!\\' |
963 '!! !!\\' |
964 ]. |
964 ]. |
965 |
965 |
966 ^ code withCRs |
966 ^ code withCRs |
967 |
967 |
968 "Modified: / 29.7.1998 / 11:29:16 / cg" |
968 "Modified: / 29.7.1998 / 11:29:16 / cg" |
1025 ' "automatically generated by UIPainter ..."\\' , |
1025 ' "automatically generated by UIPainter ..."\\' , |
1026 ' "This method is used when I am embedded as subApplication,"\' , |
1026 ' "This method is used when I am embedded as subApplication,"\' , |
1027 ' "and the mainApp wants to connect its aspects to mine."\'. |
1027 ' "and the mainApp wants to connect its aspects to mine."\'. |
1028 |
1028 |
1029 AspectsAsInstances ifTrue:[ |
1029 AspectsAsInstances ifTrue:[ |
1030 code := (code , '\' , |
1030 code := (code , '\' , |
1031 '"/ ' , aspect , ' notNil ifTrue:[\' , |
1031 '"/ ' , aspect , ' notNil ifTrue:[\' , |
1032 '"/ ' , aspect , ' removeDependent:self.\' , |
1032 '"/ ' , aspect , ' removeDependent:self.\' , |
1033 '"/ ].\' , |
1033 '"/ ].\' , |
1034 ' ' , aspect ,' := something.\' , |
1034 ' ' , aspect ,' := something.\' , |
1035 '"/ ' , aspect ,' notNil ifTrue:[\' , |
1035 '"/ ' , aspect ,' notNil ifTrue:[\' , |
1036 '"/ ' , aspect , ' addDependent:self.\' , |
1036 '"/ ' , aspect , ' addDependent:self.\' , |
1037 '"/ ].\' , |
1037 '"/ ].\' , |
1038 ' ^ self.\' , |
1038 ' ^ self.\' , |
1039 '!! !!\\') |
1039 '!! !!\\') |
1040 ] ifFalse:[ |
1040 ] ifFalse:[ |
1041 code := (code , '\' , |
1041 code := (code , '\' , |
1042 '"/ |holder|\' , |
1042 '"/ |holder|\' , |
1043 '\' , |
1043 '\' , |
1044 '"/ (holder := builder bindingAt:#' , aspect , ') notNil ifTrue:[\' , |
1044 '"/ (holder := builder bindingAt:#' , aspect , ') notNil ifTrue:[\' , |
1045 '"/ holder removeDependent:self.\' , |
1045 '"/ holder removeDependent:self.\' , |
1046 '"/ ].\' , |
1046 '"/ ].\' , |
1047 ' builder aspectAt:#' , aspect , ' put:something.\', |
1047 ' builder aspectAt:#' , aspect , ' put:something.\', |
1048 '"/ something notNil ifTrue:[\' , |
1048 '"/ something notNil ifTrue:[\' , |
1049 '"/ something addDependent:self.\' , |
1049 '"/ something addDependent:self.\' , |
1050 '"/ ].\' , |
1050 '"/ ].\' , |
1051 ' ^ self.\' , |
1051 ' ^ self.\' , |
1052 '!! !!\\') |
1052 '!! !!\\') |
1053 ]. |
1053 ]. |
1054 |
1054 |
1055 ^ code withCRs |
1055 ^ code withCRs |
1056 |
1056 |
1057 "Modified: / 29.7.1998 / 11:29:16 / cg" |
1057 "Modified: / 29.7.1998 / 11:29:16 / cg" |
1117 |code| |
1117 |code| |
1118 |
1118 |
1119 code := ''. |
1119 code := ''. |
1120 |
1120 |
1121 (targetClass includesSelector:#postBuildWith:) ifFalse:[ |
1121 (targetClass includesSelector:#postBuildWith:) ifFalse:[ |
1122 code := code |
1122 code := code |
1123 , (self |
1123 , (self |
1124 generateHookMethodFor:'postBuildWith:aBuilder' |
1124 generateHookMethodFor:'postBuildWith:aBuilder' |
1125 comment:'the widgets have been built, but before the view is opened' |
1125 comment:'the widgets have been built, but before the view is opened' |
1126 note:'or after the super send' |
1126 note:'or after the super send' |
1127 defaultCode:' super postBuildWith:aBuilder' |
1127 defaultCode:' super postBuildWith:aBuilder' |
1128 inClass:targetClass) |
1128 inClass:targetClass) |
1129 ]. |
1129 ]. |
1130 (targetClass includesSelector:#postOpenWith:) ifFalse:[ |
1130 (targetClass includesSelector:#postOpenWith:) ifFalse:[ |
1131 code := code |
1131 code := code |
1132 , (self |
1132 , (self |
1133 generateHookMethodFor:'postOpenWith:aBuilder' |
1133 generateHookMethodFor:'postOpenWith:aBuilder' |
1134 comment:'the topView has been opened, but before events are dispatched for it' |
1134 comment:'the topView has been opened, but before events are dispatched for it' |
1135 note:'or after the super send' |
1135 note:'or after the super send' |
1136 defaultCode:' super postOpenWith:aBuilder' |
1136 defaultCode:' super postOpenWith:aBuilder' |
1137 inClass:targetClass) |
1137 inClass:targetClass) |
1138 ]. |
1138 ]. |
1139 (targetClass includesSelector:#closeRequest) ifFalse:[ |
1139 (targetClass includesSelector:#closeRequest) ifFalse:[ |
1140 code := code |
1140 code := code |
1141 , (self |
1141 , (self |
1142 generateHookMethodFor:'closeRequest' |
1142 generateHookMethodFor:'closeRequest' |
1143 comment:'the topView has been asked to close' |
1143 comment:'the topView has been asked to close' |
1144 note:'return without the ''super closeRequest'' to stay open' |
1144 note:'return without the ''super closeRequest'' to stay open' |
1145 defaultCode:' ^super closeRequest' |
1145 defaultCode:' ^super closeRequest' |
1146 inClass:targetClass) |
1146 inClass:targetClass) |
1147 ]. |
1147 ]. |
1148 ^ code |
1148 ^ code |
1149 |
1149 |
1150 "Modified: / 31.10.1997 / 17:30:34 / cg" |
1150 "Modified: / 31.10.1997 / 17:30:34 / cg" |
1151 "Created: / 31.10.1997 / 17:32:49 / cg" |
1151 "Created: / 31.10.1997 / 17:32:49 / cg" |
1160 alreadyInSuperclass := targetClass superclass canUnderstand:selector. |
1160 alreadyInSuperclass := targetClass superclass canUnderstand:selector. |
1161 |
1161 |
1162 code := '!!' , targetClass name , ' methodsFor:''' , category , '''!!\\'. |
1162 code := '!!' , targetClass name , ' methodsFor:''' , category , '''!!\\'. |
1163 |
1163 |
1164 selector = 'openAboutThisApplication' ifTrue:[ |
1164 selector = 'openAboutThisApplication' ifTrue:[ |
1165 code := code , |
1165 code := code , |
1166 'openAboutThisApplication\' , |
1166 'openAboutThisApplication\' , |
1167 ' "opens an about box for this application."\\' , |
1167 ' "opens an about box for this application."\\' , |
1168 ' "automatically generated by UIPainter ..."\\' , |
1168 ' "automatically generated by UIPainter ..."\\' , |
1169 |
1169 |
1170 ' |rev box myClass clsRev image msg|\\' , |
1170 ' |rev box myClass clsRev image msg|\\' , |
1171 |
1171 |
1172 ' rev := ''''.\' , |
1172 ' rev := ''''.\' , |
1173 ' myClass := self class.\' , |
1173 ' myClass := self class.\' , |
1174 |
1174 |
1175 ' (clsRev := myClass revision) notNil ifTrue:[\' , |
1175 ' (clsRev := myClass revision) notNil ifTrue:[\' , |
1176 ' rev := '' (rev: '', clsRev printString, '')''].\\' , |
1176 ' rev := '' (rev: '', clsRev printString, '')''].\\' , |
1177 |
1177 |
1178 ' msg := Character cr asString , myClass name asBoldText, rev.\' , |
1178 ' msg := Character cr asString , myClass name asBoldText, rev.\' , |
1179 ' msg := (msg , ''\\*** add more info here ***\\'') withCRs.\\' , |
1179 ' msg := (msg , ''\\*** add more info here ***\\'') withCRs.\\' , |
1180 ' box := AboutBox title:msg.\' , |
1180 ' box := AboutBox title:msg.\' , |
1181 |
1181 |
1182 ' "/ *** add a #defaultIcon method in the class\' , |
1182 ' "/ *** add a #defaultIcon method in the class\' , |
1183 ' "/ *** and uncomment the following line:\' , |
1183 ' "/ *** and uncomment the following line:\' , |
1184 ' "/ image := self class defaultIcon.\\' , |
1184 ' "/ image := self class defaultIcon.\\' , |
1185 ' image notNil ifTrue:[\' , |
1185 ' image notNil ifTrue:[\' , |
1186 ' box image:image\' , |
1186 ' box image:image\' , |
1187 ' ].\' , |
1187 ' ].\' , |
1188 ' box label:(resources string:''About %1'' with:myClass name).\' , |
1188 ' box label:(resources string:''About %1'' with:myClass name).\' , |
1189 ' box autoHideAfter:10 with:[].\' , |
1189 ' box autoHideAfter:10 with:[].\' , |
1190 ' box showAtPointer.\' , |
1190 ' box showAtPointer.\' , |
1191 '!! !!\\'. |
1191 '!! !!\\'. |
1192 ^ code withCRs |
1192 ^ code withCRs |
1193 ]. |
1193 ]. |
1194 |
1194 |
1195 selector = 'menuOpen' ifTrue:[ |
1195 selector = 'menuOpen' ifTrue:[ |
1196 code := code , |
1196 code := code , |
1197 'menuOpen\' , |
1197 'menuOpen\' , |
1198 ' "automatically generated by UIPainter ..."\\' , |
1198 ' "automatically generated by UIPainter ..."\\' , |
1199 ' "*** the code below opens a dialog for file selection"\' , |
1199 ' "*** the code below opens a dialog for file selection"\' , |
1200 ' "*** and invokes the #doOpen: method with the selected file."\' , |
1200 ' "*** and invokes the #doOpen: method with the selected file."\' , |
1201 ' "*** Please change as required and accept in the browser."\\' , |
1201 ' "*** Please change as required and accept in the browser."\\' , |
1202 ' |file|\\' , |
1202 ' |file|\\' , |
1203 ' file :=\' , |
1203 ' file :=\' , |
1204 ' (FileSelectionBrowser\' , |
1204 ' (FileSelectionBrowser\' , |
1205 ' request: ''Open''\' , |
1205 ' request: ''Open''\' , |
1206 ' fileName: ''''\' , |
1206 ' fileName: ''''\' , |
1207 ' "/ inDirectory: lastOpenDirectory\' , |
1207 ' "/ inDirectory: lastOpenDirectory\' , |
1208 ' withFileFilters: #(''*'')).\\' , |
1208 ' withFileFilters: #(''*'')).\\' , |
1209 ' file notNil ifTrue:[\' , |
1209 ' file notNil ifTrue:[\' , |
1210 ' "/ lastOpenDirectory := file asFilename directory.\' , |
1210 ' "/ lastOpenDirectory := file asFilename directory.\' , |
1211 ' self doOpen:file\' , |
1211 ' self doOpen:file\' , |
1212 ' ]\' , |
1212 ' ]\' , |
1213 '!! !!\'. |
1213 '!! !!\'. |
1214 ^ code withCRs |
1214 ^ code withCRs |
1215 ]. |
1215 ]. |
1216 |
1216 |
1217 numArgs := selector numArgs. |
1217 numArgs := selector numArgs. |
1218 method := selector. |
1218 method := selector. |
1219 |
1219 |
1220 numArgs == 1 ifTrue:[ |
1220 numArgs == 1 ifTrue:[ |
1221 args := 'anArgument'. |
1221 args := 'anArgument'. |
1222 showIt := ''' , anArgument printString , '' ...''.\'. |
1222 showIt := ''' , anArgument printString , '' ...''.\'. |
1223 ] ifFalse:[ |
1223 ] ifFalse:[ |
1224 args := ''. |
1224 args := ''. |
1225 showIt := ' ...''.\'. |
1225 showIt := ' ...''.\'. |
1226 |
1226 |
1227 numArgs ~~ 0 ifTrue:[ |
1227 numArgs ~~ 0 ifTrue:[ |
1228 method := ''. |
1228 method := ''. |
1229 |
1229 |
1230 selector keywords keysAndValuesDo:[:i :key| |
1230 selector keywords keysAndValuesDo:[:i :key| |
1231 method := method, key, 'arg', i printString, ' ' |
1231 method := method, key, 'arg', i printString, ' ' |
1232 ] |
1232 ] |
1233 ] |
1233 ] |
1234 ]. |
1234 ]. |
1235 |
1235 |
1236 code := code , |
1236 code := code , |
1237 method , args , '\' , |
1237 method , args , '\' , |
1238 ' "automatically generated by UIPainter ..."\\' , |
1238 ' "automatically generated by UIPainter ..."\\' , |
1239 ' "*** the code below performs no action"\' , |
1239 ' "*** the code below performs no action"\' , |
1240 ' "*** (except for some feedback on the Transcript)"\' , |
1240 ' "*** (except for some feedback on the Transcript)"\' , |
1241 ' "*** Please change as required and accept in the browser."\' , |
1241 ' "*** Please change as required and accept in the browser."\' , |
1242 '\' . |
1242 '\' . |
1243 |
1243 |
1244 alreadyInSuperclass ifTrue:[ |
1244 alreadyInSuperclass ifTrue:[ |
1245 code := code , |
1245 code := code , |
1246 ' "action for ' , selector , ' is already provided in a superclass."\' , |
1246 ' "action for ' , selector , ' is already provided in a superclass."\' , |
1247 ' "It may be redefined here ..."\\'. |
1247 ' "It may be redefined here ..."\\'. |
1248 ] ifFalse:[ |
1248 ] ifFalse:[ |
1249 code := code , |
1249 code := code , |
1250 ' "action to be added ..."\\'. |
1250 ' "action to be added ..."\\'. |
1251 ]. |
1251 ]. |
1252 |
1252 |
1253 code := code , |
1253 code := code , |
1254 ' Transcript showCR:self class name, '': '. |
1254 ' Transcript showCR:self class name, '': '. |
1255 alreadyInSuperclass ifTrue:[ |
1255 alreadyInSuperclass ifTrue:[ |
1256 code := code , 'inherited '. |
1256 code := code , 'inherited '. |
1257 ]. |
1257 ]. |
1258 code := code , 'menu action for ' , selector , showIt. |
1258 code := code , 'menu action for ' , selector , showIt. |
1259 |
1259 |
1260 alreadyInSuperclass ifTrue:[ |
1260 alreadyInSuperclass ifTrue:[ |
1261 code := code , |
1261 code := code , |
1262 ' super ' , selector , args , '.\'. |
1262 ' super ' , selector , args , '.\'. |
1263 ]. |
1263 ]. |
1264 |
1264 |
1265 code := code , |
1265 code := code , |
1266 '!! !!\\'. |
1266 '!! !!\\'. |
1267 ^ code withCRs |
1267 ^ code withCRs |
1268 |
1268 |
1269 "Created: / 23.8.1998 / 16:46:51 / cg" |
1269 "Created: / 23.8.1998 / 16:46:51 / cg" |
1270 "Modified: / 23.8.1998 / 18:13:05 / cg" |
1270 "Modified: / 23.8.1998 / 18:13:05 / cg" |
1271 ! |
1271 ! |
1280 specArray fullSpec winSpec menuSpec |
1280 specArray fullSpec winSpec menuSpec |
1281 | |
1281 | |
1282 |
1282 |
1283 cls := self targetClass. |
1283 cls := self targetClass. |
1284 cls isNil ifTrue:[ |
1284 cls isNil ifTrue:[ |
1285 ^ nil |
1285 ^ nil |
1286 ]. |
1286 ]. |
1287 |
1287 |
1288 specArray := treeView generateFullSpecForComponents:#() named:nil. |
1288 specArray := treeView generateFullSpecForComponents:#() named:nil. |
1289 fullSpec := specArray decodeAsLiteralArray. |
1289 fullSpec := specArray decodeAsLiteralArray. |
1290 winSpec := fullSpec window. |
1290 winSpec := fullSpec window. |
1291 menuSelector := winSpec menu. |
1291 menuSelector := winSpec menu. |
1292 |
1292 |
1293 (menuSelector notNil |
1293 (menuSelector notNil |
1294 and:[ (cls respondsTo:menuSelector) ]) ifFalse:[ |
1294 and:[ (cls respondsTo:menuSelector) ]) ifFalse:[ |
1295 self warn:'No menu defined (yet)'. |
1295 self warn:'No menu defined (yet)'. |
1296 ^ nil. |
1296 ^ nil. |
1297 ]. |
1297 ]. |
1298 menuSpec := cls perform:menuSelector. |
1298 menuSpec := cls perform:menuSelector. |
1299 menuSpec := menuSpec decodeAsLiteralArray. |
1299 menuSpec := menuSpec decodeAsLiteralArray. |
1300 |
1300 |
1301 definedMethodSelectors := IdentitySet new. |
1301 definedMethodSelectors := IdentitySet new. |
1302 code := ''. |
1302 code := ''. |
1303 |
1303 |
1304 menuSpec allItemsDo:[:item | |
1304 menuSpec allItemsDo:[:item | |
1305 |sel| |
1305 |sel| |
1306 |
1306 |
1307 (sel := item value) notNil ifTrue:[ |
1307 (sel := item value) notNil ifTrue:[ |
1308 (definedMethodSelectors includes:sel) ifFalse:[ |
1308 (definedMethodSelectors includes:sel) ifFalse:[ |
1309 self generateCodeFrom:(Array with:sel) in:cls do:[:aSel| |
1309 self generateCodeFrom:(Array with:sel) in:cls do:[:aSel| |
1310 thisCode := (self generateMenuMethodFor:aSel inClass:cls). |
1310 thisCode := (self generateMenuMethodFor:aSel inClass:cls). |
1311 code := code, thisCode. |
1311 code := code, thisCode. |
1312 ]. |
1312 ]. |
1313 definedMethodSelectors add:sel. |
1313 definedMethodSelectors add:sel. |
1314 ]. |
1314 ]. |
1315 ] |
1315 ] |
1316 ]. |
1316 ]. |
1317 |
1317 |
1318 (definedMethodSelectors includes:#menuOpen) ifTrue:[ |
1318 (definedMethodSelectors includes:#menuOpen) ifTrue:[ |
1319 self generateCodeFrom:(Array with:#doOpen:) in:cls do:[:aSel| |
1319 self generateCodeFrom:(Array with:#doOpen:) in:cls do:[:aSel| |
1320 thisCode := (self generateMenuMethodFor:aSel inClass:cls). |
1320 thisCode := (self generateMenuMethodFor:aSel inClass:cls). |
1321 code := code, thisCode. |
1321 code := code, thisCode. |
1322 ]. |
1322 ]. |
1323 ]. |
1323 ]. |
1324 |
1324 |
1325 ^ code |
1325 ^ code |
1326 |
1326 |
1327 "Created: / 23.8.1998 / 16:12:09 / cg" |
1327 "Created: / 23.8.1998 / 16:12:09 / cg" |
1349 |spec str code category cls mthd specCode| |
1349 |spec str code category cls mthd specCode| |
1350 |
1350 |
1351 spec := OrderedCollection new. |
1351 spec := OrderedCollection new. |
1352 |
1352 |
1353 self subViews do:[:aView| |
1353 self subViews do:[:aView| |
1354 |vSpec| |
1354 |vSpec| |
1355 |
1355 |
1356 "/ care for wrapped views ... |
1356 "/ care for wrapped views ... |
1357 vSpec := self fullSpecFor:aView. |
1357 vSpec := self fullSpecFor:aView. |
1358 vSpec isNil ifTrue:[ |
1358 vSpec isNil ifTrue:[ |
1359 aView subViews size == 1 ifTrue:[ |
1359 aView subViews size == 1 ifTrue:[ |
1360 vSpec := self fullSpecFor:(aView subViews first). |
1360 vSpec := self fullSpecFor:(aView subViews first). |
1361 ] |
1361 ] |
1362 ]. |
1362 ]. |
1363 vSpec isNil ifTrue:[ |
1363 vSpec isNil ifTrue:[ |
1364 self warn:'Oops - could not create spec for some view' |
1364 self warn:'Oops - could not create spec for some view' |
1365 ]. |
1365 ]. |
1366 spec add:vSpec |
1366 spec add:vSpec |
1367 ]. |
1367 ]. |
1368 |
1368 |
1369 spec := treeView generateFullSpecForComponents:spec named:methodName. |
1369 spec := treeView generateFullSpecForComponents:spec named:methodName. |
1370 str := WriteStream on:String new. |
1370 str := WriteStream on:String new. |
1371 UISpecification prettyPrintSpecArray:spec on:str indent:5. |
1371 UISpecification prettyPrintSpecArray:spec on:str indent:5. |
1372 specCode := str contents. |
1372 specCode := str contents. |
1373 |
1373 |
1374 (specCode includes:$!!) ifTrue:[ |
1374 (specCode includes:$!!) ifTrue:[ |
1375 "/ oops - must be chunk format ... |
1375 "/ oops - must be chunk format ... |
1376 str := WriteStream on:String new. |
1376 str := WriteStream on:String new. |
1377 str nextPutAllAsChunk:specCode. |
1377 str nextPutAllAsChunk:specCode. |
1378 specCode := str contents. |
1378 specCode := str contents. |
1379 ]. |
1379 ]. |
1380 |
1380 |
1381 "/ if that method already exists, do not overwrite the category |
1381 "/ if that method already exists, do not overwrite the category |
1382 |
1382 |
1383 category := 'interface specs'. |
1383 category := 'interface specs'. |
1384 cls := self resolveName:className. |
1384 cls := self resolveName:className. |
1385 |
1385 |
1386 cls notNil ifTrue:[ |
1386 cls notNil ifTrue:[ |
1387 (mthd := cls class compiledMethodAt:methodName asSymbol) notNil ifTrue:[ |
1387 (mthd := cls class compiledMethodAt:methodName asSymbol) notNil ifTrue:[ |
1388 category := mthd category. |
1388 category := mthd category. |
1389 ] |
1389 ] |
1390 ]. |
1390 ]. |
1391 |
1391 |
1392 code := '!!' |
1392 code := '!!' |
1393 , className , ' class methodsFor:' , category storeString |
1393 , className , ' class methodsFor:' , category storeString |
1394 , '!!' , '\\' |
1394 , '!!' , '\\' |
1395 |
1395 |
1396 , methodName , '\' |
1396 , methodName , '\' |
1397 , ((ResourceSpecEditor codeGenerationCommentForClass: UIPainter) replChar:$!! withString:'!!!!') |
1397 , ((ResourceSpecEditor codeGenerationCommentForClass: UIPainter) replChar:$!! withString:'!!!!') |
1398 , '\\ "\' |
1398 , '\\ "\' |
1399 , (' UIPainter new openOnClass:' , className , ' andSelector:#' , methodName , '\'). |
1399 , (' UIPainter new openOnClass:' , className , ' andSelector:#' , methodName , '\'). |
1400 |
1400 |
1401 (cls notNil and:[cls isSubclassOf:ApplicationModel]) ifTrue:[ |
1401 (cls notNil and:[cls isSubclassOf:ApplicationModel]) ifTrue:[ |
1402 code := code |
1402 code := code |
1403 , (' ' , className , ' new openInterface:#' , methodName , '\'). |
1403 , (' ' , className , ' new openInterface:#' , methodName , '\'). |
1404 ]. |
1404 ]. |
1405 |
1405 |
1406 code := code |
1406 code := code |
1407 ,(methodName = 'windowSpec' |
1407 ,(methodName = 'windowSpec' |
1408 ifTrue:[' ' , className , ' open\'] ifFalse: ['']) |
1408 ifTrue:[' ' , className , ' open\'] ifFalse: ['']) |
1409 , ' "\'. |
1409 , ' "\'. |
1410 |
1410 |
1411 code := code |
1411 code := code |
1412 , '\' |
1412 , '\' |
1413 , ' <resource: #canvas>\\' |
1413 , ' <resource: #canvas>\\' |
1414 , ' ^ ' , specCode |
1414 , ' ^ ' , specCode |
1415 , '\' |
1415 , '\' |
1416 , '!! !!' |
1416 , '!! !!' |
1417 , '\\'. |
1417 , '\\'. |
1418 |
1418 |
1419 ^ code withCRs |
1419 ^ code withCRs |
1420 |
1420 |
1421 "Modified: / 5.9.1995 / 21:01:35 / claus" |
1421 "Modified: / 5.9.1995 / 21:01:35 / claus" |
1422 "Modified: / 15.10.1998 / 11:29:53 / cg" |
1422 "Modified: / 15.10.1998 / 11:29:53 / cg" |
1492 (MenuPanel menu: menu) startUp. |
1492 (MenuPanel menu: menu) startUp. |
1493 canvas := self painter. |
1493 canvas := self painter. |
1494 cS := canvas getSelectedViewsAndSpecs. |
1494 cS := canvas getSelectedViewsAndSpecs. |
1495 cS isNil ifTrue:[^self]. |
1495 cS isNil ifTrue:[^self]. |
1496 views := cS first. |
1496 views := cS first. |
1497 specs := cS last. |
1497 specs := cS last. |
1498 rect := views first frame. |
1498 rect := views first frame. |
1499 2 to: views size do:[:i| rect := rect merge: (views at: i) frame]. |
1499 2 to: views size do:[:i| rect := rect merge: (views at: i) frame]. |
1500 layout := LayoutFrame leftFraction:0.0 offset: rect origin x |
1500 layout := LayoutFrame leftFraction:0.0 offset: rect origin x |
1501 rightFraction:0.0 offset: rect corner x + 1 |
1501 rightFraction:0.0 offset: rect corner x + 1 |
1502 topFraction:0.0 offset: rect origin y |
1502 topFraction:0.0 offset: rect origin y |
1503 bottomFraction:0.0 offset:rect corner y + 1. |
1503 bottomFraction:0.0 offset:rect corner y + 1. |
1504 oldSelection := canvas selection. |
1504 oldSelection := canvas selection. |
1505 canvas select: views first superView. |
1505 canvas select: views first superView. |
1506 spec layout: layout. |
1506 spec layout: layout. |
1507 spec class == VerticalPanelViewSpec ifTrue:[ |
1507 spec class == VerticalPanelViewSpec ifTrue:[ |
1508 spec verticalLayout: #topSpace. |
1508 spec verticalLayout: #topSpace. |
1509 spec horizontalLayout: #fit. |
1509 spec horizontalLayout: #fit. |
1510 ]. |
1510 ]. |
1511 spec class == HorizontalPanelViewSpec ifTrue:[ |
1511 spec class == HorizontalPanelViewSpec ifTrue:[ |
1512 spec verticalLayout: #fit. |
1512 spec verticalLayout: #fit. |
1513 spec horizontalLayout: #leftSpace. |
1513 spec horizontalLayout: #leftSpace. |
1514 ]. |
1514 ]. |
1515 |
1515 |
1516 box := self pasteSpecifications:spec keepLayout:true at:nil. |
1516 box := self pasteSpecifications:spec keepLayout:true at:nil. |
1517 |
1517 |
1518 xOffset := box origin x. |
1518 xOffset := box origin x. |
1519 yOffset := box origin y. |
1519 yOffset := box origin y. |
1520 withLayout ifFalse:[ |
1520 withLayout ifFalse:[ |
1521 1 to: specs size do:[:i| |
1521 1 to: specs size do:[:i| |
1522 view := views at: i. |
1522 view := views at: i. |
1523 layout := LayoutFrame leftFraction:0.0 offset: (view origin x - xOffset) |
1523 layout := LayoutFrame leftFraction:0.0 offset: (view origin x - xOffset) |
1524 rightFraction:0.0 offset: (view corner x - xOffset + 1) |
1524 rightFraction:0.0 offset: (view corner x - xOffset + 1) |
1525 topFraction:0.0 offset: (view origin y - yOffset ) |
1525 topFraction:0.0 offset: (view origin y - yOffset ) |
1526 bottomFraction:0.0 offset: (view corner y - yOffset + 1). |
1526 bottomFraction:0.0 offset: (view corner y - yOffset + 1). |
1527 (specs at: i) layout: layout. |
1527 (specs at: i) layout: layout. |
1528 ]. |
1528 ]. |
1529 ]. |
1529 ]. |
1530 canvas selection: oldSelection. |
1530 canvas selection: oldSelection. |
1531 canvas deleteSelection. |
1531 canvas deleteSelection. |
1532 canvas selection:box. |
1532 canvas selection:box. |
1533 nViews := canvas pasteSpecifications:specs keepLayout:true. |
1533 nViews := canvas pasteSpecifications:specs keepLayout:true. |
1534 canvas selection: box. |
1534 canvas selection: box. |
1553 cS isNil ifTrue:[^self]. |
1553 cS isNil ifTrue:[^self]. |
1554 views := cS first first subViews copy. |
1554 views := cS first first subViews copy. |
1555 superView := cS first first superView. |
1555 superView := cS first first superView. |
1556 cS last first component isNil ifTrue:[^self]. |
1556 cS last first component isNil ifTrue:[^self]. |
1557 cS last first component collection isEmpty ifTrue:[^self]. |
1557 cS last first component collection isEmpty ifTrue:[^self]. |
1558 specs := cS last first component collection copy. |
1558 specs := cS last first component collection copy. |
1559 frame := cS first first frame. |
1559 frame := cS first first frame. |
1560 canvas deleteSelection. |
1560 canvas deleteSelection. |
1561 withLayout ifFalse:[ |
1561 withLayout ifFalse:[ |
1562 1 to: specs size do:[:i| |
1562 1 to: specs size do:[:i| |
1563 view := views at: i. |
1563 view := views at: i. |
1564 layout := LayoutFrame leftFraction:0.0 offset: (view origin x + frame origin x) |
1564 layout := LayoutFrame leftFraction:0.0 offset: (view origin x + frame origin x) |
1565 rightFraction:0.0 offset: (view corner x + frame origin x + 1) |
1565 rightFraction:0.0 offset: (view corner x + frame origin x + 1) |
1566 topFraction:0.0 offset: (view origin y + frame origin y ) |
1566 topFraction:0.0 offset: (view origin y + frame origin y ) |
1567 bottomFraction:0.0 offset: (view corner y + frame origin y + 1). |
1567 bottomFraction:0.0 offset: (view corner y + frame origin y + 1). |
1568 (specs at: i) layout: layout. |
1568 (specs at: i) layout: layout. |
1569 ]. |
1569 ]. |
1570 ]. |
1570 ]. |
1571 canvas selection: superView. |
1571 canvas selection: superView. |
1572 canvas pasteSpecifications:specs keepLayout:true. |
1572 canvas pasteSpecifications:specs keepLayout:true. |
1573 canvas selection: superView. |
1573 canvas selection: superView. |
1574 ! |
1574 ! |
1575 |
1575 |
1609 setupFromSpec:specOrSpecArray |
1609 setupFromSpec:specOrSpecArray |
1610 |
1610 |
1611 |spec builder| |
1611 |spec builder| |
1612 |
1612 |
1613 Cursor wait showWhile: [ |
1613 Cursor wait showWhile: [ |
1614 self removeAll. |
1614 self removeAll. |
1615 specOrSpecArray notNil ifTrue:[ |
1615 specOrSpecArray notNil ifTrue:[ |
1616 spec := UISpecification from:specOrSpecArray. |
1616 spec := UISpecification from:specOrSpecArray. |
1617 ]. |
1617 ]. |
1618 builder := UIBuilder new isEditing:true. |
1618 builder := UIBuilder new isEditing:true. |
1619 "set applicationClass, in order that subspecifications may be resolved" |
1619 "set applicationClass, in order that subspecifications may be resolved" |
1620 className notNil ifTrue:[ |
1620 className notNil ifTrue:[ |
1621 builder applicationClass:(self resolveName:className). |
1621 builder applicationClass:(self resolveName:className). |
1622 ]. |
1622 ]. |
1623 spec notNil ifTrue:[ |
1623 spec notNil ifTrue:[ |
1624 spec window setupView:self topView for:builder. |
1624 spec window setupView:self topView for:builder. |
1625 self addSpec:(spec component) builder:builder in:self. |
1625 self addSpec:(spec component) builder:builder in:self. |
1626 ]. |
1626 ]. |
1627 self realizeAllSubViews. |
1627 self realizeAllSubViews. |
1628 spec notNil ifTrue:[ |
1628 spec notNil ifTrue:[ |
1629 treeView setAttributesFromWindowSpec:(spec window) |
1629 treeView setAttributesFromWindowSpec:(spec window) |
1630 ]. |
1630 ]. |
1631 ]. |
1631 ]. |
1632 ! |
1632 ! |
1633 |
1633 |
1634 treeView:aTreeView |
1634 treeView:aTreeView |
1635 treeView := aTreeView. |
1635 treeView := aTreeView. |
1636 |
1636 |
1637 treeView delegate:( |
1637 treeView delegate:( |
1638 "/ |
1638 "/ |
1639 "/ I want to handle everything typed |
1639 "/ I want to handle everything typed |
1640 "/ in the treeView, except for Return and Cursor-keys |
1640 "/ in the treeView, except for Return and Cursor-keys |
1641 "/ |
1641 "/ |
1642 KeyboardForwarder |
1642 KeyboardForwarder |
1643 toView:self |
1643 toView:self |
1644 condition:nil |
1644 condition:nil |
1645 filter:[:k | (k isSymbol |
1645 filter:[:k | (k isSymbol |
1646 and:[k ~~ #Return |
1646 and:[k ~~ #Return |
1647 and:[k ~~ #Tab |
1647 and:[k ~~ #Tab |
1648 and:[(k startsWith:#Cursor) not]]]) |
1648 and:[(k startsWith:#Cursor) not]]]) |
1649 ] |
1649 ] |
1650 ) |
1650 ) |
1651 |
1651 |
1652 "Modified: / 31.10.1997 / 20:22:09 / cg" |
1652 "Modified: / 31.10.1997 / 20:22:09 / cg" |
1653 ! ! |
1653 ! ! |
1654 |
1654 |
1677 "show object selected |
1677 "show object selected |
1678 " |
1678 " |
1679 |wasClipped sel hColor bg| |
1679 |wasClipped sel hColor bg| |
1680 |
1680 |
1681 selectionHiddenLevel == 0 ifTrue:[ |
1681 selectionHiddenLevel == 0 ifTrue:[ |
1682 sel := treeView selection. |
1682 sel := treeView selection. |
1683 (sel size > 1 and: |
1683 (sel size > 1 and: |
1684 [(treeView model list at: sel first) contents view == aComponent]) |
1684 [(treeView model list at: sel first) contents view == aComponent]) |
1685 ifTrue: [ |
1685 ifTrue: [ |
1686 hColor := handleMasterColor |
1686 hColor := handleMasterColor |
1687 ] ifFalse:[ |
1687 ] ifFalse:[ |
1688 bg := aComponent viewBackground. |
1688 bg := aComponent viewBackground. |
1689 bg isColor ifTrue:[ |
1689 bg isColor ifTrue:[ |
1690 bg brightness < 0.5 ifTrue:[ |
1690 bg brightness < 0.5 ifTrue:[ |
1691 hColor := handleColorWhite |
1691 hColor := handleColorWhite |
1692 ] ifFalse:[ |
1692 ] ifFalse:[ |
1693 hColor := handleColorBlack |
1693 hColor := handleColorBlack |
1694 ] |
1694 ] |
1695 ] ifFalse:[ |
1695 ] ifFalse:[ |
1696 hColor := handleColorBlack |
1696 hColor := handleColorBlack |
1697 ] |
1697 ] |
1698 ]. |
1698 ]. |
1699 |
1699 |
1700 self paint:hColor. |
1700 self paint:hColor. |
1701 |
1701 |
1702 (wasClipped := clipChildren) ifTrue:[ |
1702 (wasClipped := clipChildren) ifTrue:[ |
1703 self clippedByChildren:(clipChildren := false). |
1703 self clippedByChildren:(clipChildren := false). |
1704 ]. |
1704 ]. |
1705 |
1705 |
1706 self handlesOf:aComponent do:[:aRectangle :what| |l t w h| |
1706 self handlesOf:aComponent do:[:aRectangle :what| |l t w h| |
1707 l := aRectangle left + 1. |
1707 l := aRectangle left + 1. |
1708 t := aRectangle top + 1. |
1708 t := aRectangle top + 1. |
1709 w := aRectangle width - 2. |
1709 w := aRectangle width - 2. |
1710 h := aRectangle height - 2. |
1710 h := aRectangle height - 2. |
1711 |
1711 |
1712 what == #view ifTrue:[self displayRectangleX:l y:t width:w height:h] |
1712 what == #view ifTrue:[self displayRectangleX:l y:t width:w height:h] |
1713 ifFalse:[self fillRectangleX:l y:t width:w height:h] |
1713 ifFalse:[self fillRectangleX:l y:t width:w height:h] |
1714 ]. |
1714 ]. |
1715 |
1715 |
1716 wasClipped ifTrue:[ |
1716 wasClipped ifTrue:[ |
1717 self clippedByChildren:(clipChildren := true). |
1717 self clippedByChildren:(clipChildren := true). |
1718 ] |
1718 ] |
1719 ] |
1719 ] |
1720 |
1720 |
1721 "Modified: / 6.12.2001 / 00:00:16 / cg" |
1721 "Modified: / 6.12.2001 / 00:00:16 / cg" |
1722 ! ! |
1722 ! ! |
1723 |
1723 |
1889 |
1889 |
1890 addToSelection:anObject |
1890 addToSelection:anObject |
1891 "add an object to the selection |
1891 "add an object to the selection |
1892 " |
1892 " |
1893 (self enabled and:[(self isSelected:anObject) not]) ifTrue:[ |
1893 (self enabled and:[(self isSelected:anObject) not]) ifTrue:[ |
1894 selection isCollection ifFalse:[ |
1894 selection isCollection ifFalse:[ |
1895 selection isNil ifTrue:[ |
1895 selection isNil ifTrue:[ |
1896 selection := anObject |
1896 selection := anObject |
1897 ] ifFalse:[ |
1897 ] ifFalse:[ |
1898 selection := OrderedCollection with:selection with:anObject |
1898 selection := OrderedCollection with:selection with:anObject |
1899 ] |
1899 ] |
1900 ] ifTrue:[ |
1900 ] ifTrue:[ |
1901 "/ to enforce the change-message (value is identical to oldValue) |
1901 "/ to enforce the change-message (value is identical to oldValue) |
1902 selection isList ifTrue:[ |
1902 selection isList ifTrue:[ |
1903 selection add:anObject |
1903 selection add:anObject |
1904 ] ifFalse:[ |
1904 ] ifFalse:[ |
1905 selection := selection asOrderedCollection. |
1905 selection := selection asOrderedCollection. |
1906 selection := selection copyWith:anObject |
1906 selection := selection copyWith:anObject |
1907 ] |
1907 ] |
1908 ]. |
1908 ]. |
1909 self showSelected:anObject. |
1909 self showSelected:anObject. |
1910 treeView cvsSelectionAdd:anObject. |
1910 treeView cvsSelectionAdd:anObject. |
1911 ] |
1911 ] |
1912 |
1912 |
1913 "Modified: / 11.2.2000 / 01:39:05 / cg" |
1913 "Modified: / 11.2.2000 / 01:39:05 / cg" |
1914 ! |
1914 ! |
1915 |
1915 |
1916 removeFromSelection:anObject |
1916 removeFromSelection:anObject |
1917 "remove an object from the selection |
1917 "remove an object from the selection |
1918 " |
1918 " |
1919 (self isSelected:anObject) ifTrue:[ |
1919 (self isSelected:anObject) ifTrue:[ |
1920 self showUnselected:anObject. |
1920 self showUnselected:anObject. |
1921 |
1921 |
1922 selection size > 1 ifTrue:[ |
1922 selection size > 1 ifTrue:[ |
1923 selection isList ifTrue:[ |
1923 selection isList ifTrue:[ |
1924 selection remove:anObject ifAbsent:nil |
1924 selection remove:anObject ifAbsent:nil |
1925 ] ifFalse:[ |
1925 ] ifFalse:[ |
1926 "/ to enforce the change-message (value is identical to oldValue) |
1926 "/ to enforce the change-message (value is identical to oldValue) |
1927 selection := selection asOrderedCollection. |
1927 selection := selection asOrderedCollection. |
1928 selection := selection copyWithout:anObject |
1928 selection := selection copyWithout:anObject |
1929 ]. |
1929 ]. |
1930 self showSelection. |
1930 self showSelection. |
1931 ] ifFalse:[ |
1931 ] ifFalse:[ |
1932 selection := nil |
1932 selection := nil |
1933 ]. |
1933 ]. |
1934 treeView cvsSelectionRemove:anObject. |
1934 treeView cvsSelectionRemove:anObject. |
1935 ] |
1935 ] |
1936 |
1936 |
1937 "Modified: / 11.2.2000 / 01:41:11 / cg" |
1937 "Modified: / 11.2.2000 / 01:41:11 / cg" |
1938 ! |
1938 ! |
1939 |
1939 |
1940 select:something |
1940 select:something |
1941 "change selection to something |
1941 "change selection to something |
1942 " |
1942 " |
1943 (self enabled and:[something ~= self selection]) ifTrue:[ |
1943 (self enabled and:[something ~= self selection]) ifTrue:[ |
1944 something isNil |
1944 something isNil |
1945 ifTrue: [treeView selection: (Array with: 1)] |
1945 ifTrue: [treeView selection: (Array with: 1)] |
1946 ifFalse:[treeView cvsSelection:something]. |
1946 ifFalse:[treeView cvsSelection:something]. |
1947 self setSelection:something withRedraw:true |
1947 self setSelection:something withRedraw:true |
1948 ] |
1948 ] |
1949 |
1949 |
1950 ! |
1950 ! |
1951 |
1951 |
1952 selectNextUpInHierarchy |
1952 selectNextUpInHierarchy |
1953 | sel | |
1953 | sel | |
1954 |
1954 |
1955 (sel := self selection) isNil ifTrue:[^self]. |
1955 (sel := self selection) isNil ifTrue:[^self]. |
1956 sel isCollection ifTrue:[ |
1956 sel isCollection ifTrue:[ |
1957 sel := self selection first. |
1957 sel := self selection first. |
1958 ]. |
1958 ]. |
1959 sel := sel superView. |
1959 sel := sel superView. |
1960 sel isNil ifTrue:[^self]. |
1960 sel isNil ifTrue:[^self]. |
1961 treeView cvsSelection: sel. |
1961 treeView cvsSelection: sel. |
1962 self selection: sel. |
1962 self selection: sel. |
2053 |
2053 |
2054 rebuildView:aView fromSpec:aSpec withBuilder:aBuilderOrNil |
2054 rebuildView:aView fromSpec:aSpec withBuilder:aBuilderOrNil |
2055 |v builder| |
2055 |v builder| |
2056 |
2056 |
2057 (builder := aBuilderOrNil) isNil ifTrue:[ |
2057 (builder := aBuilderOrNil) isNil ifTrue:[ |
2058 "/ create a dummy builder |
2058 "/ create a dummy builder |
2059 builder := UIBuilder new isEditing:true. |
2059 builder := UIBuilder new isEditing:true. |
2060 className notNil ifTrue:[ |
2060 className notNil ifTrue:[ |
2061 builder applicationClass:(self resolveName:className). |
2061 builder applicationClass:(self resolveName:className). |
2062 ]. |
2062 ]. |
2063 ]. |
2063 ]. |
2064 |
2064 |
2065 aSpec class isLayoutContainer ifTrue:[ |
2065 aSpec class isLayoutContainer ifTrue:[ |
2066 "/ TODO: |
2066 "/ TODO: |
2067 "/ go through subviews and let them resize to their default/preferred |
2067 "/ go through subviews and let them resize to their default/preferred |
2068 "/ needed if we change a containers layout from fit to non-fit. |
2068 "/ needed if we change a containers layout from fit to non-fit. |
2069 |
2069 |
2070 (aView subViews ? #()) do:[:aSubView | |
2070 (aView subViews ? #()) do:[:aSubView | |
2071 |fix spec prop| |
2071 |fix spec prop| |
2072 |
2072 |
2073 (prop := self propertyOfView:aSubView) notNil ifTrue:[ |
2073 (prop := self propertyOfView:aSubView) notNil ifTrue:[ |
2074 spec := prop spec. |
2074 spec := prop spec. |
2075 |
2075 |
2076 spec useDefaultExtent ifTrue:[ |
2076 spec useDefaultExtent ifTrue:[ |
2077 fix := aSubView sizeFixed:false. |
2077 fix := aSubView sizeFixed:false. |
2078 aSubView extent:aSubView preferredExtent. |
2078 aSubView extent:aSubView preferredExtent. |
2079 aSubView sizeFixed:fix |
2079 aSubView sizeFixed:fix |
2080 ] |
2080 ] |
2081 ] |
2081 ] |
2082 ]. |
2082 ]. |
2083 ]. |
2083 ]. |
2084 |
2084 |
2085 aSpec needsRebuildForAttributes ifTrue:[ |
2085 aSpec needsRebuildForAttributes ifTrue:[ |
2086 "/ needs a full rebuild (in case view class depends upon spec-attribute) |
2086 "/ needs a full rebuild (in case view class depends upon spec-attribute) |
2087 v := aSpec buildViewWithLayoutFor:builder in:(self findContainerOfView:aView). |
2087 v := aSpec buildViewWithLayoutFor:builder in:(self findContainerOfView:aView). |
2088 v realize. |
2088 v realize. |
2089 aView destroy. |
2089 aView destroy. |
2090 device sync. |
2090 device sync. |
2091 device flush. |
2091 device flush. |
2092 aView becomeSameAs:v. |
2092 aView becomeSameAs:v. |
2093 inputView raise. |
2093 "/ inputView raise. |
2094 ] ifFalse:[ |
2094 ] ifFalse:[ |
2095 aSpec setAttributesIn:aView with:builder. |
2095 aSpec setAttributesIn:aView with:builder. |
2096 self elementChangedSize:aView. |
2096 self elementChangedSize:aView. |
2097 ]. |
2097 ]. |
2098 |
2098 |
2099 ! |
2099 ! |
2100 |
2100 |
2101 specFor:anObject |
2101 specFor:anObject |
2251 "create undo action before changing a views layout |
2251 "create undo action before changing a views layout |
2252 " |
2252 " |
2253 |lyt args prop| |
2253 |lyt args prop| |
2254 |
2254 |
2255 undoHistory isTransactionOpen ifTrue:[ |
2255 undoHistory isTransactionOpen ifTrue:[ |
2256 prop := self propertyOfView:aView. |
2256 prop := self propertyOfView:aView. |
2257 |
2257 |
2258 prop notNil ifTrue:[ |
2258 prop notNil ifTrue:[ |
2259 args := Array new:3. |
2259 args := Array new:3. |
2260 args at:1 put:(prop identifier). |
2260 args at:1 put:(prop identifier). |
2261 |
2261 |
2262 (lyt := aView geometryLayout) notNil ifTrue:[ |
2262 (lyt := aView geometryLayout) notNil ifTrue:[ |
2263 args at:2 put:#geometryLayout: |
2263 args at:2 put:#geometryLayout: |
2264 ] ifFalse:[ |
2264 ] ifFalse:[ |
2265 lyt := aView extent. |
2265 lyt := aView extent. |
2266 args at:2 put:#extent: |
2266 args at:2 put:#extent: |
2267 ]. |
2267 ]. |
2268 args at:3 put:(lyt copy). |
2268 args at:3 put:(lyt copy). |
2269 undoHistory addUndoSelector:#undoLayout: withArgs:args. |
2269 undoHistory addUndoSelector:#undoLayout: withArgs:args. |
2270 ] |
2270 ] |
2271 ] |
2271 ] |
2272 ! |
2272 ! |
2273 |
2273 |
2274 createUndoRemove:aView |
2274 createUndoRemove:aView |
2275 "create undo method before deleting views |
2275 "create undo method before deleting views |
2276 " |
2276 " |
2277 |prop pid| |
2277 |prop pid| |
2278 |
2278 |
2279 (prop := self propertyOfView:aView) notNil ifTrue:[ |
2279 (prop := self propertyOfView:aView) notNil ifTrue:[ |
2280 (pid := self propertyOfParentForView:aView) notNil ifTrue:[ |
2280 (pid := self propertyOfParentForView:aView) notNil ifTrue:[ |
2281 pid := pid identifier |
2281 pid := pid identifier |
2282 ]. |
2282 ]. |
2283 |
2283 |
2284 undoHistory addUndoSelector:#undoRemove: |
2284 undoHistory addUndoSelector:#undoRemove: |
2285 withArgs:(Array with:(self fullSpecFor:aView) |
2285 withArgs:(Array with:(self fullSpecFor:aView) |
2286 with:(prop identifier) |
2286 with:(prop identifier) |
2287 with:pid) |
2287 with:pid) |
2288 ] |
2288 ] |
2289 ! |
2289 ! |
2290 |
2290 |
2291 createUndoSpecModify:aProp |
2291 createUndoSpecModify:aProp |
2292 "undo method when changing the specification for an object |
2292 "undo method when changing the specification for an object |
2293 " |
2293 " |
2294 aProp notNil ifTrue:[ |
2294 aProp notNil ifTrue:[ |
2295 undoHistory addUndoSelector:#undoSpecModify: |
2295 undoHistory addUndoSelector:#undoSpecModify: |
2296 withArgs:(Array with:(aProp spec) with:(aProp identifier)) |
2296 withArgs:(Array with:(aProp spec) with:(aProp identifier)) |
2297 ] |
2297 ] |
2298 ! |
2298 ! |
2299 |
2299 |
2300 undoCreate:something |
2300 undoCreate:something |
2301 "undo method for creating or pasting an object |
2301 "undo method for creating or pasting an object |