540 |
558 |
541 saveAndTerminate |
559 saveAndTerminate |
542 ObjectMemory snapShotOn:name |
560 ObjectMemory snapShotOn:name |
543 ! ! |
561 ! ! |
544 |
562 |
545 !Launcher methodsFor:'user interaction'! |
563 !Launcher methodsFor:'menu actions'! |
|
564 |
|
565 startSystemBrowser |
|
566 SystemBrowser open |
|
567 ! |
|
568 |
|
569 startHierarchyBrowser |
|
570 enterBox title:(resources at:'name of class:') withCRs. |
|
571 enterBox okText:(resources at:'browse'). |
|
572 |
|
573 enterBox action:[:className | |
|
574 |class| |
|
575 |
|
576 class := Smalltalk at:className asSymbol ifAbsent:[nil]. |
|
577 class isBehavior ifFalse:[ |
|
578 self warn:(resources at:'no such class') |
|
579 ] ifTrue:[ |
|
580 SystemBrowser browseClassHierarchy:class |
|
581 ] |
|
582 ]. |
|
583 enterBox showAtPointer |
|
584 ! |
|
585 |
|
586 startImplementorsBrowser |
|
587 enterBox title:(resources at:'selector:') withCRs. |
|
588 enterBox okText:(resources at:'browse'). |
|
589 |
|
590 enterBox action:[:selectorName | |
|
591 SystemBrowser browseImplementorsOf:selectorName |
|
592 ]. |
|
593 enterBox showAtPointer |
|
594 ! |
|
595 |
|
596 startSendersBrowser |
|
597 enterBox title:(resources at:'selector:') withCRs. |
|
598 enterBox okText:(resources at:'browse'). |
|
599 |
|
600 enterBox action:[:selectorName | |
|
601 SystemBrowser browseAllCallsOn:selectorName |
|
602 ]. |
|
603 enterBox showAtPointer |
|
604 ! |
|
605 |
|
606 startChangesBrowser |
|
607 ChangesBrowser open |
|
608 ! |
|
609 |
|
610 startFileBrowser |
|
611 FileBrowser open |
|
612 ! |
|
613 |
|
614 startDirectoryBrowser |
|
615 DirectoryBrowser open |
|
616 ! |
|
617 |
|
618 startDirectoryView |
|
619 DirectoryView open |
|
620 ! |
|
621 |
|
622 startWorkspace |
|
623 Workspace open |
|
624 ! |
|
625 |
|
626 saveImage |
|
627 saveBox isNil ifTrue:[ |
|
628 saveBox := EnterBox new. |
|
629 saveBox title:(resources at:'filename for image:') withCRs. |
|
630 " saveBox abortText:(resources at:'abort')." "this is the default anyway ..." |
|
631 saveBox okText:(resources at:'save') |
|
632 ]. |
|
633 |
|
634 "this is a kludge - put into above if-block once |
|
635 stack contexts survive a snapout/snapin |
|
636 (I think, it could be done now ...) |
|
637 " |
|
638 saveBox action:[:fileName | |
|
639 ObjectMemory snapShotOn:fileName. |
|
640 ]. |
|
641 |
|
642 saveBox initialText:(ObjectMemory nameForSnapshot). |
|
643 saveBox showAtPointer |
|
644 ! |
|
645 |
|
646 exitSmalltalk |
|
647 exitBox isNil ifTrue:[ |
|
648 exitBox := EnterBox2 new. |
|
649 exitBox title:(resources at:'save state before exiting ?\\filename for image:') withCRs. |
|
650 " exitBox abortText:(resources at:'abort')." "this is the default anyway ..." |
|
651 exitBox okText:(resources at:'exit'). |
|
652 exitBox okText2:(resources at:'save & exit'). |
|
653 ]. |
|
654 |
|
655 exitBox action:[:dummyName | |
|
656 self closeDownViews. |
|
657 Smalltalk exit |
|
658 ]. |
|
659 |
|
660 exitBox action2:[:fileName | |
|
661 ObjectMemory snapShotOn:fileName. |
|
662 |
|
663 "this is NOT required - all data should be in the snapshot ... |
|
664 ... however, if remote disks/mounatble filesystems are involved, |
|
665 which may not be present the next time, it may make sense to |
|
666 uncomment it and query for saving - time will show which is better. |
|
667 " |
|
668 " |
|
669 self closeDownViews. |
|
670 " |
|
671 Smalltalk exit |
|
672 ]. |
|
673 |
|
674 exitBox initialText:(ObjectMemory nameForSnapshot). |
|
675 exitBox showAtPointer |
|
676 ! ! |
|
677 |
|
678 !Launcher methodsFor:'utility menu actions'! |
546 |
679 |
547 viewHardcopy |
680 viewHardcopy |
548 Processor addTimedBlock:[ |
681 Processor addTimedBlock:[ |
549 |v| |
682 |v| |
550 |
683 |
568 area := Rectangle fromUser. |
701 area := Rectangle fromUser. |
569 (area width > 0 and:[area height > 0]) ifTrue:[ |
702 (area width > 0 and:[area height > 0]) ifTrue:[ |
570 self saveScreenImage:(Image fromScreen:area) |
703 self saveScreenImage:(Image fromScreen:area) |
571 ] |
704 ] |
572 ] afterSeconds:1 |
705 ] afterSeconds:1 |
573 ! |
|
574 |
|
575 startSystemBrowser |
|
576 SystemBrowser open |
|
577 ! |
|
578 |
|
579 startHierarchyBrowser |
|
580 enterBox title:(resources at:'name of class:') withCRs. |
|
581 enterBox okText:(resources at:'browse'). |
|
582 |
|
583 enterBox action:[:className | |
|
584 |class| |
|
585 |
|
586 class := Smalltalk at:className asSymbol ifAbsent:[nil]. |
|
587 class isBehavior ifFalse:[ |
|
588 self warn:(resources at:'no such class') |
|
589 ] ifTrue:[ |
|
590 SystemBrowser browseClassHierarchy:class |
|
591 ] |
|
592 ]. |
|
593 enterBox showAtPointer |
|
594 ! |
|
595 |
|
596 startImplementorsBrowser |
|
597 enterBox title:(resources at:'selector:') withCRs. |
|
598 enterBox okText:(resources at:'browse'). |
|
599 |
|
600 enterBox action:[:selectorName | |
|
601 SystemBrowser browseImplementorsOf:selectorName |
|
602 ]. |
|
603 enterBox showAtPointer |
|
604 ! |
|
605 |
|
606 startSendersBrowser |
|
607 enterBox title:(resources at:'selector:') withCRs. |
|
608 enterBox okText:(resources at:'browse'). |
|
609 |
|
610 enterBox action:[:selectorName | |
|
611 SystemBrowser browseAllCallsOn:selectorName |
|
612 ]. |
|
613 enterBox showAtPointer |
|
614 ! |
|
615 |
|
616 startChangesBrowser |
|
617 ChangesBrowser open |
|
618 ! |
|
619 |
|
620 startFileBrowser |
|
621 FileBrowser open |
|
622 ! |
|
623 |
|
624 startDirectoryBrowser |
|
625 DirectoryBrowser open |
|
626 ! |
|
627 |
|
628 startDirectoryView |
|
629 DirectoryView open |
|
630 ! |
|
631 |
|
632 startWorkspace |
|
633 Workspace open |
|
634 ! |
|
635 |
|
636 startWindowTreeView |
|
637 WindowTreeView open |
|
638 ! |
706 ! |
639 |
707 |
640 viewKiller |
708 viewKiller |
641 |v| |
709 |v| |
642 |
710 |
703 LightInTheDark open |
775 LightInTheDark open |
704 ! |
776 ! |
705 |
777 |
706 startScreenSaver3 |
778 startScreenSaver3 |
707 LightInTheDark2 open |
779 LightInTheDark2 open |
708 ! |
|
709 |
|
710 newProject |
|
711 (ProjectView for:(Project new)) open |
|
712 ! |
|
713 |
|
714 selectProject |
|
715 |list box| |
|
716 |
|
717 list := Project allInstances. |
|
718 box := ListSelectionBox new. |
|
719 box list:(list collect:[:p | p name]). |
|
720 box title:(resources string:'select a project'). |
|
721 box action:[:selection | |
|
722 |project| |
|
723 |
|
724 project := list detect:[:p | p name = selection] ifNone:[nil]. |
|
725 project isNil ifTrue:[ |
|
726 Transcript showCr:'no such project' |
|
727 ] ifFalse:[ |
|
728 project showViews. |
|
729 Project current:project |
|
730 ] |
|
731 ]. |
|
732 box showAtPointer |
|
733 ! |
|
734 |
|
735 startXterm |
|
736 OperatingSystem executeCommand:'xterm &' |
|
737 ! |
|
738 |
|
739 startAddressBook |
|
740 AddressBook open |
|
741 ! |
|
742 |
|
743 startNewsTool |
|
744 NewsView open |
|
745 ! |
|
746 |
|
747 startMailTool |
|
748 MailView open |
|
749 ! |
|
750 |
|
751 startClock |
|
752 Clock open |
|
753 ! |
|
754 |
|
755 startRoundClock |
|
756 RoundClock2 open |
|
757 ! |
|
758 |
|
759 startAnimation |
|
760 Animation open |
|
761 ! |
|
762 |
|
763 startGlobeDemo |
|
764 GlobeDemo open |
|
765 ! |
|
766 |
|
767 startRoundGlobeDemo |
|
768 RoundGlobeDemo open |
|
769 ! |
|
770 |
|
771 startGLSphereDemo |
|
772 GLSphereDemoView2 open |
|
773 ! |
|
774 |
|
775 startGLTeapotDemo |
|
776 GLTeapotDemo open |
|
777 ! |
|
778 |
|
779 startGLPlaneDemo |
|
780 GLPlaneDemoView2 open |
|
781 ! |
|
782 |
|
783 startGLWireCubeDemo |
|
784 GLWireCubeDemoView open |
|
785 ! |
|
786 |
|
787 startGLCubeDemo |
|
788 GLCubeDemoView open |
|
789 ! |
|
790 |
|
791 startGLCubeDemo2 |
|
792 GLCubeDemoView2 open |
|
793 ! |
|
794 |
|
795 startGLTetraDemo |
|
796 GLTetraDemoView open |
|
797 ! |
|
798 |
|
799 startGLLogoDemo1 |
|
800 Logo3DView1 open |
|
801 ! |
|
802 |
|
803 startTetris |
|
804 Tetris open |
|
805 ! |
|
806 |
|
807 startTicTacToe |
|
808 TicTacToe open |
|
809 ! |
|
810 |
|
811 startDrawTool |
|
812 DrawTool open |
|
813 ! |
|
814 |
|
815 startLogicTool |
|
816 LogicTool open |
|
817 ! |
780 ! |
818 |
781 |
819 garbageCollect |
782 garbageCollect |
820 ObjectMemory markAndSweep |
783 ObjectMemory markAndSweep |
821 ! |
784 ! |
839 ] ifFalse:[ |
802 ] ifFalse:[ |
840 Transcript show:nReclaimed printString. |
803 Transcript show:nReclaimed printString. |
841 Transcript showCr:' bytes.' |
804 Transcript showCr:' bytes.' |
842 ] |
805 ] |
843 ] |
806 ] |
844 ! |
807 ! ! |
|
808 |
|
809 !Launcher methodsFor:'project menu actions'! |
|
810 |
|
811 newProject |
|
812 (ProjectView for:(Project new)) open |
|
813 ! |
|
814 |
|
815 selectProject |
|
816 |list box| |
|
817 |
|
818 list := Project allInstances. |
|
819 box := ListSelectionBox new. |
|
820 box list:(list collect:[:p | p name]). |
|
821 box title:(resources string:'select a project'). |
|
822 box action:[:selection | |
|
823 |project| |
|
824 |
|
825 project := list detect:[:p | p name = selection] ifNone:[nil]. |
|
826 project isNil ifTrue:[ |
|
827 Transcript showCr:'no such project' |
|
828 ] ifFalse:[ |
|
829 project showViews. |
|
830 Project current:project |
|
831 ] |
|
832 ]. |
|
833 box showAtPointer |
|
834 ! ! |
|
835 |
|
836 !Launcher methodsFor:'goody menu actions'! |
|
837 |
|
838 startXterm |
|
839 OperatingSystem executeCommand:'xterm &' |
|
840 ! |
|
841 |
|
842 startAddressBook |
|
843 AddressBook open |
|
844 ! |
|
845 |
|
846 startNewsTool |
|
847 NewsView open |
|
848 ! |
|
849 |
|
850 startMailTool |
|
851 MailView open |
|
852 ! |
|
853 |
|
854 startClock |
|
855 Clock open |
|
856 ! |
|
857 |
|
858 startRoundClock |
|
859 RoundClock2 open |
|
860 ! ! |
|
861 |
|
862 !Launcher methodsFor:'demo menu actions'! |
|
863 |
|
864 startAnimation |
|
865 Animation open |
|
866 ! |
|
867 |
|
868 startGlobeDemo |
|
869 GlobeDemo open |
|
870 ! |
|
871 |
|
872 startRoundGlobeDemo |
|
873 RoundGlobeDemo open |
|
874 ! |
|
875 |
|
876 startGLSphereDemo |
|
877 GLSphereDemoView2 open |
|
878 ! |
|
879 |
|
880 startGLTeapotDemo |
|
881 GLTeapotDemo open |
|
882 ! |
|
883 |
|
884 startGLPlaneDemo |
|
885 GLPlaneDemoView2 open |
|
886 ! |
|
887 |
|
888 startGLWireCubeDemo |
|
889 GLWireCubeDemoView open |
|
890 ! |
|
891 |
|
892 startGLWireSphereDemo |
|
893 GLWireSphereDemoView open |
|
894 ! |
|
895 |
|
896 startGLPlanetDemo |
|
897 GLPlanetDemoView open |
|
898 ! |
|
899 |
|
900 startGLCubeDemo |
|
901 GLCubeDemoView open |
|
902 ! |
|
903 |
|
904 startGLCubeDemo2 |
|
905 GLCubeDemoView2 open |
|
906 ! |
|
907 |
|
908 startGLTetraDemo |
|
909 GLTetraDemoView open |
|
910 ! |
|
911 |
|
912 startGLLogoDemo1 |
|
913 Logo3DView1 open |
|
914 ! |
|
915 |
|
916 startTetris |
|
917 Tetris open |
|
918 ! |
|
919 |
|
920 startTicTacToe |
|
921 TicTacToe open |
|
922 ! |
|
923 |
|
924 startDrawTool |
|
925 DrawTool open |
|
926 ! |
|
927 |
|
928 startLogicTool |
|
929 LogicTool open |
|
930 ! ! |
|
931 |
|
932 !Launcher methodsFor:'doc menu actions'! |
845 |
933 |
846 warnIfAbsent:aPath |
934 warnIfAbsent:aPath |
847 |s| |
935 |s| |
848 |
936 |
849 s := Smalltalk systemFileStreamFor:aPath. |
937 s := Smalltalk systemFileStreamFor:aPath. |
987 ]. |
1083 ]. |
988 self warn:'The HelpSystem is still under construction. |
1084 self warn:'The HelpSystem is still under construction. |
989 |
1085 |
990 You will see a pre release.'. |
1086 You will see a pre release.'. |
991 ManualBrowser new |
1087 ManualBrowser new |
992 ! |
1088 ! ! |
993 |
|
994 saveImage |
|
995 saveBox isNil ifTrue:[ |
|
996 saveBox := EnterBox new. |
|
997 saveBox title:(resources at:'filename for image:') withCRs. |
|
998 " saveBox abortText:(resources at:'abort')." "this is the default anyway ..." |
|
999 saveBox okText:(resources at:'save') |
|
1000 ]. |
|
1001 |
|
1002 "this is a kludge - put into above if-block once |
|
1003 stack contexts survive a snapout/snapin |
|
1004 (I think, it could be done now ...) |
|
1005 " |
|
1006 saveBox action:[:fileName | |
|
1007 ObjectMemory snapShotOn:fileName. |
|
1008 ]. |
|
1009 |
|
1010 saveBox initialText:(ObjectMemory nameForSnapshot). |
|
1011 saveBox showAtPointer |
|
1012 ! |
|
1013 |
|
1014 exitSmalltalk |
|
1015 exitBox isNil ifTrue:[ |
|
1016 exitBox := EnterBox2 new. |
|
1017 exitBox title:(resources at:'save state before exiting ?\\filename for image:') withCRs. |
|
1018 " exitBox abortText:(resources at:'abort')." "this is the default anyway ..." |
|
1019 exitBox okText:(resources at:'exit'). |
|
1020 exitBox okText2:(resources at:'save & exit'). |
|
1021 ]. |
|
1022 |
|
1023 exitBox action:[:dummyName | |
|
1024 self closeDownViews. |
|
1025 Smalltalk exit |
|
1026 ]. |
|
1027 |
|
1028 exitBox action2:[:fileName | |
|
1029 ObjectMemory snapShotOn:fileName. |
|
1030 |
|
1031 "this is NOT required - all data should be in the snapshot ... |
|
1032 ... however, if remote disks/mounatble filesystems are involved, |
|
1033 which may not be present the next time, it may make sense to |
|
1034 uncomment it and query for saving - time will show which is better. |
|
1035 " |
|
1036 " |
|
1037 self closeDownViews. |
|
1038 " |
|
1039 Smalltalk exit |
|
1040 ]. |
|
1041 |
|
1042 exitBox initialText:(ObjectMemory nameForSnapshot). |
|
1043 exitBox showAtPointer |
|
1044 ! ! |
|