542 "Modified: 7.1.1997 / 23:03:47 / cg" |
546 "Modified: 7.1.1997 / 23:03:47 / cg" |
543 ! ! |
547 ! ! |
544 |
548 |
545 !ChangesBrowser methodsFor:'private'! |
549 !ChangesBrowser methodsFor:'private'! |
546 |
550 |
|
551 autoSelect:changeNr |
|
552 "select a change" |
|
553 |
|
554 self class autoSelectNext ifTrue:[ |
|
555 (changeNr <= self numberOfChanges) ifTrue:[ |
|
556 changeListView setSelection:changeNr. |
|
557 self changeSelection:changeNr. |
|
558 ^ self |
|
559 ] |
|
560 ]. |
|
561 self clearCodeView. |
|
562 changeListView setSelection:nil. |
|
563 |
|
564 "Modified: / 18.5.1998 / 14:26:43 / cg" |
|
565 ! |
|
566 |
|
567 autoSelectLast |
|
568 "select the last change" |
|
569 |
|
570 self autoSelect:(self numberOfChanges) |
|
571 ! |
|
572 |
|
573 autoSelectOrEnd:changeNr |
|
574 "select the next change or the last" |
|
575 |
|
576 |last| |
|
577 |
|
578 last := self numberOfChanges. |
|
579 changeNr < last ifTrue:[ |
|
580 self autoSelect:changeNr |
|
581 ] ifFalse:[ |
|
582 changeListView setSelection:last . |
|
583 self changeSelection:last. |
|
584 ] |
|
585 |
|
586 "Modified: 25.5.1996 / 12:26:17 / cg" |
|
587 ! |
|
588 |
|
589 checkClassIsLoaded:aClass |
|
590 |cls| |
|
591 |
|
592 aClass isMeta ifTrue:[ |
|
593 cls := aClass soleInstance |
|
594 ] ifFalse:[ |
|
595 cls := aClass |
|
596 ]. |
|
597 cls isLoaded ifFalse:[ |
|
598 (self confirm:(cls name , ' is an autoloaded class.\I can only compare the methods texts if its loaded first.\\Load the class first ?') withCRs) |
|
599 ifTrue:[ |
|
600 cls autoload |
|
601 ] |
|
602 ]. |
|
603 ^ cls isLoaded |
|
604 |
|
605 "Created: 12.12.1995 / 14:04:39 / cg" |
|
606 "Modified: 12.12.1995 / 14:11:05 / cg" |
|
607 ! |
|
608 |
|
609 clearCodeView |
|
610 self unselect "changeListView deselect". |
|
611 codeView contents:nil. |
|
612 changeNrShown := nil |
|
613 ! |
|
614 |
|
615 contractClass:className selector:selector to:maxLen |
|
616 |s l| |
|
617 |
|
618 s := className , ' ', selector. |
|
619 s size > maxLen ifTrue:[ |
|
620 l := maxLen - 1 - selector size max:20. |
|
621 s := (className contractTo:l) , ' ' , selector. |
|
622 |
|
623 s size > maxLen ifTrue:[ |
|
624 l := maxLen - 1 - className size max:20. |
|
625 s := className , ' ', (selector contractTo:l). |
|
626 |
|
627 s size > maxLen ifTrue:[ |
|
628 s := (className contractTo:(maxLen // 2 - 1)) , ' ' , (selector contractTo:maxLen // 2) |
|
629 ] |
|
630 ] |
|
631 ]. |
|
632 ^ s |
|
633 ! |
|
634 |
|
635 newLabel:how |
|
636 |l| |
|
637 |
|
638 (changeFileName ~= 'changes') ifTrue:[ |
|
639 l := self class defaultLabel , ': ', changeFileName |
|
640 ] ifFalse:[ |
|
641 l := self class defaultLabel |
|
642 ]. |
|
643 l := l , ' ' , how. |
|
644 self label:l |
|
645 |
|
646 "Created: / 8.9.1995 / 19:32:04 / claus" |
|
647 "Modified: / 8.9.1995 / 19:39:29 / claus" |
|
648 "Modified: / 6.2.1998 / 13:27:01 / cg" |
|
649 ! |
|
650 |
|
651 queryCloseText |
|
652 "made this a method for easy redefinition in subclasses" |
|
653 |
|
654 ^ 'Quit without updating changeFile ?' |
|
655 ! |
|
656 |
|
657 setChangeList |
|
658 "extract type-information from changes and stuff into top selection |
|
659 view" |
|
660 |
|
661 changeListView setList:changeHeaderLines expandTabs:false redraw:false. |
|
662 changeListView invalidate. |
|
663 |
|
664 "/ changeListView deselect. |
|
665 |
|
666 "Modified: / 18.5.1998 / 14:29:10 / cg" |
|
667 ! |
|
668 |
|
669 showNotFound |
|
670 |savedCursor| |
|
671 |
|
672 savedCursor := cursor. |
|
673 [ |
|
674 self cursor:(Cursor cross). |
|
675 self beep. |
|
676 Delay waitForMilliseconds:300. |
|
677 ] valueNowOrOnUnwindDo:[ |
|
678 self cursor:savedCursor |
|
679 ] |
|
680 |
|
681 "Modified: / 29.4.1999 / 22:36:54 / cg" |
|
682 ! |
|
683 |
|
684 unselect |
|
685 "common unselect" |
|
686 |
|
687 changeListView setSelection:nil. |
|
688 |
|
689 "Modified: 25.5.1996 / 13:02:49 / cg" |
|
690 ! |
|
691 |
|
692 withSelectedChangeDo:aBlock |
|
693 "just a helper, check for a selected change and evaluate aBlock |
|
694 with busy cursor" |
|
695 |
|
696 |changeNr| |
|
697 |
|
698 changeNr := changeListView selection. |
|
699 changeNr notNil ifTrue:[ |
|
700 self withExecuteCursorDo:[ |
|
701 aBlock value:changeNr |
|
702 ] |
|
703 ] |
|
704 |
|
705 "Modified: 14.12.1995 / 20:58:45 / cg" |
|
706 ! ! |
|
707 |
|
708 !ChangesBrowser methodsFor:'private-change access'! |
|
709 |
|
710 changeIsFollowupMethodChange:changeNr |
|
711 ^ changeIsFollowupMethodChange at:changeNr |
|
712 |
|
713 "Created: / 6.2.1998 / 13:03:39 / cg" |
|
714 ! |
|
715 |
|
716 classNameOfChange:changeNr |
|
717 "return the classname of a change |
|
718 (for classChanges (i.e. xxx class), the non-metaClassName (i.e. xxx) is returned)" |
|
719 |
|
720 |name| |
|
721 |
|
722 name := self fullClassNameOfChange:changeNr. |
|
723 name isNil ifTrue:[^ nil]. |
|
724 (name endsWith:' class') ifTrue:[ |
|
725 ^ name copyWithoutLast:6 |
|
726 ]. |
|
727 ^ name |
|
728 |
|
729 "Modified: 6.12.1995 / 17:06:31 / cg" |
|
730 ! |
|
731 |
|
732 fullClassNameOfChange:changeNr |
|
733 "return the full classname of a change |
|
734 (for classChanges (i.e. xxx class), a string ending in ' class' is returned. |
|
735 - since parsing ascii methods is slow, keep result cached in |
|
736 changeClassNames for the next query" |
|
737 |
|
738 |chunk aParseTree recTree sel name arg1Tree isMeta prevMethodDefNr |
|
739 words changeStream fullParseTree ownerTree ownerName oldDollarSetting| |
|
740 |
|
741 changeNr isNil ifTrue:[^ nil]. |
|
742 |
|
743 " |
|
744 first look, if not already known |
|
745 " |
|
746 name := changeClassNames at:changeNr. |
|
747 name notNil ifTrue:[^ name]. |
|
748 |
|
749 prevMethodDefNr := changeNr. |
|
750 [changeIsFollowupMethodChange at:prevMethodDefNr] whileTrue:[ |
|
751 prevMethodDefNr := prevMethodDefNr - 1. |
|
752 ]. |
|
753 |
|
754 " |
|
755 get the chunk |
|
756 " |
|
757 chunk := changeChunks at:prevMethodDefNr. |
|
758 chunk isNil ifTrue:[^ nil]. "mhmh - empty" |
|
759 |
|
760 (chunk startsWith:'''---') ifTrue:[ |
|
761 words := chunk asCollectionOfWords. |
|
762 words size > 2 ifTrue:[ |
|
763 (words at:2) = 'checkin' ifTrue:[ |
|
764 name := words at:3. |
|
765 changeClassNames at:changeNr put:name. |
|
766 ^ name |
|
767 ] |
|
768 ]. |
|
769 ]. |
|
770 |
|
771 "/ fix it - otherwise, it cannot be parsed |
|
772 (chunk endsWith:'primitiveDefinitions:') ifTrue:[ |
|
773 chunk := chunk , '''''' |
|
774 ]. |
|
775 (chunk endsWith:'primitiveFunctions:') ifTrue:[ |
|
776 chunk := chunk , '''''' |
|
777 ]. |
|
778 (chunk endsWith:'primitiveVariables:') ifTrue:[ |
|
779 chunk := chunk , '''''' |
|
780 ]. |
|
781 |
|
782 " |
|
783 use parser to construct a parseTree |
|
784 " |
|
785 oldDollarSetting := Parser allowDollarInIdentifier. |
|
786 [ |
|
787 Parser allowDollarInIdentifier:true. |
|
788 aParseTree := Parser parseExpression:chunk. |
|
789 |
|
790 aParseTree == #Error ifTrue:[ |
|
791 (chunk includesString:'comment') ifTrue:[ |
|
792 "/ could be a comment ... |
|
793 aParseTree := Parser parseExpression:chunk , ''''. |
|
794 ] |
|
795 ]. |
|
796 ] valueNowOrOnUnwindDo:[ |
|
797 Parser allowDollarInIdentifier:oldDollarSetting |
|
798 ]. |
|
799 |
|
800 (aParseTree isNil or:[aParseTree == #Error]) ifTrue:[ |
|
801 ^ nil "seems strange ... (could be a comment)" |
|
802 ]. |
|
803 aParseTree isMessage ifFalse:[ |
|
804 ^ nil "very strange ... (whats that ?)" |
|
805 ]. |
|
806 |
|
807 " |
|
808 ask parser for selector |
|
809 " |
|
810 sel := aParseTree selector. |
|
811 recTree := aParseTree receiver. |
|
812 |
|
813 " |
|
814 is it a method-change, methodRemove or comment-change ? |
|
815 " |
|
816 |
|
817 (#(#'methodsFor:' |
|
818 #'privateMethodsFor:' |
|
819 #'protectedMethodsFor:' |
|
820 #'ignoredMethodsFor:' |
|
821 #'publicMethodsFor:' |
|
822 #'removeSelector:' |
|
823 #'comment:' |
|
824 #'primitiveDefinitions:' |
|
825 #'primitiveFunctions:' |
|
826 #'primitiveVariables:' |
|
827 #'renameCategory:to:' |
|
828 #'instanceVariableNames:' |
|
829 |
|
830 #'methodsFor:stamp:' "/ Squeak support |
|
831 #'commentStamp:prior:' "/ Squeak support |
|
832 #'addClassVarName:' "/ Squeak support |
|
833 ) includes:sel) ifTrue:[ |
|
834 " |
|
835 yes, the className is the receiver |
|
836 " |
|
837 (recTree notNil and:[recTree ~~ #Error]) ifTrue:[ |
|
838 isMeta := false. |
|
839 recTree isUnaryMessage ifTrue:[ |
|
840 (recTree selector ~~ #class) ifTrue:[^ nil]. |
|
841 "id class methodsFor:..." |
|
842 recTree := recTree receiver. |
|
843 isMeta := true. |
|
844 ]. |
|
845 recTree isPrimary ifTrue:[ |
|
846 name := recTree name. |
|
847 isMeta ifTrue:[ |
|
848 name := name , ' class'. |
|
849 ]. |
|
850 changeClassNames at:changeNr put:name. |
|
851 ^ name |
|
852 ] |
|
853 ]. |
|
854 "more strange things" |
|
855 ^ nil |
|
856 ]. |
|
857 |
|
858 " |
|
859 is it a change in a class-description ? |
|
860 " |
|
861 (('subclass:*' match:sel) |
|
862 or:[('variable*subclass:*' match:sel)]) ifTrue:[ |
|
863 "/ must parse the full changes text, to get |
|
864 "/ privacy information. |
|
865 |
|
866 changeStream := self streamForChange:changeNr. |
|
867 changeStream notNil ifTrue:[ |
|
868 chunk := changeStream nextChunk. |
|
869 changeStream close. |
|
870 fullParseTree := Parser parseExpression:chunk. |
|
871 (fullParseTree isNil or:[fullParseTree == #Error]) ifTrue:[ |
|
872 fullParseTree := nil |
|
873 ]. |
|
874 fullParseTree isMessage ifFalse:[ |
|
875 fullParseTree := nil |
|
876 ]. |
|
877 "/ actually, the nil case cannot happen |
|
878 fullParseTree notNil ifTrue:[ |
|
879 aParseTree := fullParseTree. |
|
880 sel := aParseTree selector. |
|
881 ]. |
|
882 ]. |
|
883 |
|
884 arg1Tree := aParseTree arg1. |
|
885 (arg1Tree notNil and:[arg1Tree isConstant]) ifTrue:[ |
|
886 name := arg1Tree value asString. |
|
887 |
|
888 "/ is it a private-class ? |
|
889 ('*privateIn:' match:sel) ifTrue:[ |
|
890 ownerTree := aParseTree args last. |
|
891 ownerName := ownerTree name asString. |
|
892 name := ownerName , '::' , name |
|
893 ]. |
|
894 changeClassNames at:changeNr put:name. |
|
895 ^ name |
|
896 ]. |
|
897 "very strange" |
|
898 ^ nil |
|
899 ]. |
|
900 |
|
901 " |
|
902 is it a class remove ? |
|
903 " |
|
904 (sel == #removeClass:) ifTrue:[ |
|
905 (recTree notNil |
|
906 and:[recTree ~~ #Error |
|
907 and:[recTree isPrimary |
|
908 and:[recTree name = 'Smalltalk']]]) ifTrue:[ |
|
909 arg1Tree := aParseTree arg1. |
|
910 (arg1Tree notNil and:[arg1Tree isPrimary]) ifTrue:[ |
|
911 name := arg1Tree name. |
|
912 changeClassNames at:changeNr put:name. |
|
913 ^ name |
|
914 ]. |
|
915 ] |
|
916 ]. |
|
917 |
|
918 " |
|
919 is it a method category change ? |
|
920 " |
|
921 ((sel == #category:) |
|
922 or:[sel == #privacy:]) ifTrue:[ |
|
923 (recTree notNil |
|
924 and:[recTree ~~ #Error |
|
925 and:[recTree isMessage |
|
926 and:[recTree selector == #compiledMethodAt:]]]) ifTrue:[ |
|
927 isMeta := false. |
|
928 recTree := recTree receiver. |
|
929 recTree isUnaryMessage ifTrue:[ |
|
930 (recTree selector ~~ #class) ifTrue:[^ nil]. |
|
931 "id class " |
|
932 recTree := recTree receiver |
|
933 ]. |
|
934 recTree isPrimary ifTrue:[ |
|
935 isMeta ifTrue:[ |
|
936 name := name , ' class'. |
|
937 ]. |
|
938 name := recTree name. |
|
939 changeClassNames at:changeNr put:name. |
|
940 ^ name |
|
941 ] |
|
942 ] |
|
943 ]. |
|
944 ^ nil |
|
945 |
|
946 "Modified: / 3.8.1998 / 19:58:17 / cg" |
|
947 ! |
|
948 |
|
949 numberOfChanges |
|
950 ^ changePositions size |
|
951 |
|
952 "Created: 3.12.1995 / 18:15:39 / cg" |
|
953 ! |
|
954 |
|
955 selectorOfMethodChange:changeNr |
|
956 "return a method-changes selector, or nil if its not a methodChange" |
|
957 |
|
958 |source parser sel chunk aParseTree | |
|
959 |
|
960 source := self sourceOfMethodChange:changeNr. |
|
961 source isNil ifTrue:[ |
|
962 (self classNameOfChange:changeNr) notNil ifTrue:[ |
|
963 chunk := changeChunks at:changeNr. |
|
964 chunk isNil ifTrue:[^ nil]. "mhmh - empty" |
|
965 aParseTree := Parser parseExpression:chunk. |
|
966 (aParseTree isNil or:[aParseTree == #Error]) ifTrue:[ |
|
967 ^ nil "seems strange ... (could be a comment)" |
|
968 ]. |
|
969 aParseTree isMessage ifFalse:[ |
|
970 ^ nil "very strange ... (whats that ?)" |
|
971 ]. |
|
972 sel := aParseTree selector. |
|
973 (#( |
|
974 #'removeSelector:' |
|
975 ) includes:sel) ifTrue:[ |
|
976 sel := aParseTree arguments at:1. |
|
977 sel isConstant ifTrue:[ |
|
978 sel := sel evaluate. |
|
979 sel isSymbol ifTrue:[ |
|
980 ^ sel |
|
981 ] |
|
982 ] |
|
983 ] |
|
984 ]. |
|
985 ^ nil |
|
986 ]. |
|
987 |
|
988 |
|
989 parser := Parser |
|
990 parseMethodArgAndVarSpecification:source |
|
991 in:nil |
|
992 ignoreErrors:true |
|
993 ignoreWarnings:true |
|
994 parseBody:false. |
|
995 |
|
996 "/ parser := Parser |
|
997 "/ parseMethod:source |
|
998 "/ in:nil |
|
999 "/ ignoreErrors:true |
|
1000 "/ ignoreWarnings:true. |
|
1001 |
|
1002 (parser notNil and:[parser ~~ #Error]) ifTrue:[ |
|
1003 sel := parser selector. |
|
1004 ]. |
|
1005 ^ sel |
|
1006 |
|
1007 "Created: 24.11.1995 / 14:30:46 / cg" |
|
1008 "Modified: 5.9.1996 / 17:12:50 / cg" |
|
1009 ! |
|
1010 |
|
1011 sourceOfMethodChange:changeNr |
|
1012 "return a method-changes source code, or nil if its not a methodChange." |
|
1013 |
|
1014 |aStream chunk sawExcla parseTree sourceChunk sel| |
|
1015 |
|
1016 aStream := self streamForChange:changeNr. |
|
1017 aStream isNil ifTrue:[^ nil]. |
|
1018 |
|
1019 (self changeIsFollowupMethodChange:changeNr) ifFalse:[ |
|
1020 sawExcla := aStream peekFor:(aStream class chunkSeparator). |
|
1021 chunk := aStream nextChunk. |
|
1022 ] ifTrue:[ |
|
1023 chunk := (changeChunks at:changeNr). |
|
1024 sawExcla := true. |
|
1025 ]. |
|
1026 |
|
1027 sawExcla ifTrue:[ |
|
1028 parseTree := Parser parseExpression:chunk. |
|
1029 (parseTree notNil and:[parseTree isMessage]) ifTrue:[ |
|
1030 sel := parseTree selector. |
|
1031 (#( |
|
1032 #methodsFor: |
|
1033 #privateMethodsFor: |
|
1034 #publicMethodsFor: |
|
1035 #ignoredMethodsFor: |
|
1036 #protectedMethodsFor: |
|
1037 |
|
1038 #methodsFor:stamp: "/ Squeak support |
|
1039 #commentStamp:prior: "/ Squeak support |
|
1040 ) |
|
1041 includes:sel) ifTrue:[ |
|
1042 sourceChunk := aStream nextChunk. |
|
1043 ] |
|
1044 ]. |
|
1045 ]. |
|
1046 aStream close. |
|
1047 ^ sourceChunk |
|
1048 |
|
1049 "Created: / 5.9.1996 / 17:11:32 / cg" |
|
1050 "Modified: / 3.8.1998 / 20:00:21 / cg" |
|
1051 ! |
|
1052 |
|
1053 streamForChange:changeNr |
|
1054 "answer a stream for change" |
|
1055 |
|
1056 |aStream| |
|
1057 |
|
1058 (changeNr between:1 and:changePositions size) ifFalse:[^ nil]. |
|
1059 aStream := FileStream readonlyFileNamed:changeFileName. |
|
1060 aStream isNil ifTrue:[^ nil]. |
|
1061 aStream position:(changePositions at:changeNr). |
|
1062 ^ aStream |
|
1063 ! ! |
|
1064 |
|
1065 !ChangesBrowser methodsFor:'private-changeFile access'! |
|
1066 |
|
1067 changeFileName:aFileName |
|
1068 changeFileName := aFileName |
|
1069 ! |
|
1070 |
|
1071 checkIfFileHasChanged |
|
1072 |f info | |
|
1073 |
|
1074 Processor removeTimedBlock:checkBlock. |
|
1075 f := changeFileName asFilename. |
|
1076 (info := f info) isNil ifTrue:[ |
|
1077 self newLabel:'(unaccessable)' |
|
1078 ] ifFalse:[ |
|
1079 (info modified) > changeFileTimestamp ifTrue:[ |
|
1080 self newLabel:'(outdated)'. |
|
1081 autoUpdate ifTrue:[ |
|
1082 self doUpdate |
|
1083 ] |
|
1084 ] ifFalse:[ |
|
1085 self newLabel:'' |
|
1086 ] |
|
1087 ]. |
|
1088 Processor addTimedBlock:checkBlock afterSeconds:5. |
|
1089 |
|
1090 "Created: 8.9.1995 / 19:30:19 / claus" |
|
1091 "Modified: 8.9.1995 / 19:38:18 / claus" |
|
1092 "Modified: 1.11.1996 / 20:22:56 / cg" |
|
1093 ! |
|
1094 |
|
1095 readChangesFile |
|
1096 "read the changes file, create a list of header-lines (changeChunks) |
|
1097 and a list of chunk-positions (changePositions)" |
|
1098 |
|
1099 ^ self readChangesFileInBackground:false |
|
1100 ! |
|
1101 |
|
1102 readChangesFileInBackground:inBackground |
|
1103 "read the changes file, create a list of header-lines (changeChunks) |
|
1104 and a list of chunk-positions (changePositions). |
|
1105 Starting with 2.10.3, the entries are multi-col entries; |
|
1106 the cols are: |
|
1107 1 delta (only if comparing) |
|
1108 '+' -> new method (w.r.t. current state) |
|
1109 '-' -> removed method (w.r.t. current state) |
|
1110 '?' -> class does not exist currently |
|
1111 '=' -> change is same as current methods source |
|
1112 2 class/selector |
|
1113 3 type of change |
|
1114 doit |
|
1115 method |
|
1116 category change |
|
1117 4 timestamp |
|
1118 |
|
1119 since comparing slows down startup time, it is now disabled by |
|
1120 default and can be enabled via a toggle." |
|
1121 |
|
1122 |aStream maxLen i f chunkText fullChunkText| |
|
1123 |
|
1124 editingClassSource := false. |
|
1125 |
|
1126 maxLen := 60. |
|
1127 |
|
1128 f := changeFileName asFilename. |
|
1129 aStream := f readStream. |
|
1130 aStream isNil ifTrue:[^ nil]. |
|
1131 |
|
1132 self newLabel:'updating ...'. |
|
1133 |
|
1134 i := f info. |
|
1135 changeFileSize := i size. |
|
1136 changeFileTimestamp := i modified. |
|
1137 |
|
1138 self withReadCursorDo:[ |
|
1139 |myProcess myPriority| |
|
1140 |
|
1141 " |
|
1142 this is a time consuming operation (especially, if reading an |
|
1143 NFS-mounted directory; therefore lower my priority ... |
|
1144 " |
|
1145 inBackground ifTrue:[ |
|
1146 myProcess := Processor activeProcess. |
|
1147 myPriority := myProcess priority. |
|
1148 myProcess priority:(Processor userBackgroundPriority). |
|
1149 ]. |
|
1150 |
|
1151 [ |
|
1152 |excla timeStampInfo| |
|
1153 |
|
1154 changeChunks := OrderedCollection new. |
|
1155 changeHeaderLines := OrderedCollection new. |
|
1156 changePositions := OrderedCollection new. |
|
1157 changeTimeStamps := OrderedCollection new. |
|
1158 changeIsFollowupMethodChange := OrderedCollection new. |
|
1159 |
|
1160 excla := aStream class chunkSeparator. |
|
1161 |
|
1162 [aStream atEnd] whileFalse:[ |
|
1163 |entry changeDelta changeString changeType |
|
1164 line s l changeClass sawExcla category |
|
1165 chunkPos sel| |
|
1166 |
|
1167 " |
|
1168 get a chunk (separated by excla) |
|
1169 " |
|
1170 aStream skipSeparators. |
|
1171 chunkPos := aStream position. |
|
1172 |
|
1173 |
|
1174 sawExcla := aStream peekFor:excla. |
|
1175 chunkText := fullChunkText := aStream nextChunk. |
|
1176 chunkText notNil ifTrue:[ |
|
1177 |index headerLine cls| |
|
1178 |
|
1179 (chunkText startsWith:'''---- timestamp ') ifTrue:[ |
|
1180 timeStampInfo := (chunkText copyFrom:16 to:(chunkText size - 6)) withoutSpaces. |
|
1181 ] ifFalse:[ |
|
1182 |
|
1183 " |
|
1184 only first line is saved in changeChunks ... |
|
1185 " |
|
1186 index := chunkText indexOf:(Character cr). |
|
1187 (index ~~ 0) ifTrue:[ |
|
1188 chunkText := chunkText copyTo:(index - 1). |
|
1189 |
|
1190 "take care for comment changes - must still be a |
|
1191 valid expression for classNameOfChange: to work" |
|
1192 |
|
1193 (chunkText endsWith:'comment:''') ifTrue:[ |
|
1194 chunkText := chunkText , '...''' |
|
1195 ]. |
|
1196 (chunkText endsWith:'primitiveDefinitions:''') ifTrue:[ |
|
1197 sel := 'primitiveDefinitions:'. |
|
1198 chunkText := chunkText copyWithoutLast:1 |
|
1199 ]. |
|
1200 (chunkText endsWith:'primitiveVariables:''') ifTrue:[ |
|
1201 sel := 'primitiveVariables:'. |
|
1202 chunkText := chunkText copyWithoutLast:1 |
|
1203 ]. |
|
1204 (chunkText endsWith:'primitiveFunctions:''') ifTrue:[ |
|
1205 sel := 'primitiveFunctions:'. |
|
1206 chunkText := chunkText copyWithoutLast:1 |
|
1207 ]. |
|
1208 ]. |
|
1209 |
|
1210 changeChunks add:chunkText. |
|
1211 changePositions add:chunkPos. |
|
1212 changeTimeStamps add:timeStampInfo. |
|
1213 changeIsFollowupMethodChange add:false. |
|
1214 |
|
1215 headerLine := nil. |
|
1216 changeDelta := ' '. |
|
1217 |
|
1218 sawExcla ifFalse:[ |
|
1219 (chunkText startsWith:'''---- snap') ifTrue:[ |
|
1220 changeType := ''. |
|
1221 headerLine := chunkText. |
|
1222 changeString := (chunkText contractTo:maxLen). |
|
1223 timeStampInfo := nil. |
|
1224 ] ifFalse:[ |
|
1225 |
|
1226 |p cls clsName| |
|
1227 |
|
1228 headerLine := chunkText , ' (doIt)'. |
|
1229 |
|
1230 " |
|
1231 first, assume doIt - then lets have a more detailed look ... |
|
1232 " |
|
1233 ((chunkText startsWith:'''---- file') |
|
1234 or:[(chunkText startsWith:'''---- check')]) ifTrue:[ |
|
1235 changeType := ''. |
|
1236 timeStampInfo := nil. |
|
1237 ] ifFalse:[ |
|
1238 changeType := '(doIt)'. |
|
1239 ]. |
|
1240 changeString := (chunkText contractTo:maxLen). |
|
1241 |
|
1242 p := Parser parseExpression:fullChunkText inNameSpace:Smalltalk. |
|
1243 (p notNil and:[p ~~ #Error]) ifTrue:[ |
|
1244 p isMessage ifTrue:[ |
|
1245 sel := p selector. |
|
1246 ] |
|
1247 ] ifFalse:[ |
|
1248 sel := nil. |
|
1249 (Scanner new scanTokens:fullChunkText) size == 0 ifTrue:[ |
|
1250 "/ a comment only |
|
1251 changeType := '(comment)'. |
|
1252 ] ifFalse:[ |
|
1253 changeType := '(???)'. |
|
1254 ] |
|
1255 ]. |
|
1256 (sel == #removeSelector:) ifTrue:[ |
|
1257 p receiver isUnaryMessage ifTrue:[ |
|
1258 cls := p receiver receiver name. |
|
1259 changeClass := (Smalltalk classNamed:cls) class. |
|
1260 cls := cls , ' class'. |
|
1261 ] ifFalse:[ |
|
1262 cls := p receiver name. |
|
1263 changeClass := (Smalltalk classNamed:cls) |
|
1264 ]. |
|
1265 sel := (p args at:1) evaluate. |
|
1266 |
|
1267 compareChanges ifTrue:[ |
|
1268 (changeClass isNil or:[changeClass isLoaded not]) ifTrue:[ |
|
1269 changeDelta := '?' |
|
1270 ] ifFalse:[ |
|
1271 (changeClass implements:sel asSymbol) ifTrue:[ |
|
1272 changeDelta := '-'. |
|
1273 ] ifFalse:[ |
|
1274 changeDelta := '='. |
|
1275 ] |
|
1276 ] |
|
1277 ]. |
|
1278 changeType := '(remove)'. |
|
1279 changeString := self contractClass:cls selector:sel to:maxLen. |
|
1280 ]. |
|
1281 (p ~~ #Error |
|
1282 and:[p isMessage |
|
1283 and:[p receiver isMessage |
|
1284 and:[p receiver selector == #compiledMethodAt:]]]) ifTrue:[ |
|
1285 p receiver receiver isUnaryMessage ifTrue:[ |
|
1286 cls := p receiver receiver receiver name. |
|
1287 changeClass := (Smalltalk classNamed:cls) class. |
|
1288 cls := cls , ' class'. |
|
1289 ] ifFalse:[ |
|
1290 cls := p receiver receiver name. |
|
1291 changeClass := (Smalltalk classNamed:cls) |
|
1292 ]. |
|
1293 (sel == #category:) ifTrue:[ |
|
1294 sel := (p receiver args at:1) evaluate. |
|
1295 changeType := '(category change)'. |
|
1296 changeString := self contractClass:cls selector:sel to:maxLen. |
|
1297 ]. |
|
1298 (sel == #privacy:) ifTrue:[ |
|
1299 sel := (p receiver args at:1) evaluate. |
|
1300 changeType := '(privacy change)'. |
|
1301 changeString := self contractClass:cls selector:sel to:maxLen. |
|
1302 ]. |
|
1303 ]. |
|
1304 (#(#'subclass:' |
|
1305 #'variableSubclass:' |
|
1306 #'variableByteSubclass:' |
|
1307 #'variableWordSubclass:' |
|
1308 #'variableLongSubclass:' |
|
1309 #'variableFloatSubclass:' |
|
1310 #'variableDoubleSubclass:' |
|
1311 #'primitiveDefinitions:' |
|
1312 #'primitiveFunctions:' |
|
1313 #'primitiveVariables:' |
|
1314 ) includes:sel) ifTrue:[ |
|
1315 changeType := '(class definition)'. |
|
1316 clsName := (p args at:1) evaluate. |
|
1317 cls := Smalltalk at:clsName ifAbsent:nil. |
|
1318 cls isNil ifTrue:[ |
|
1319 changeDelta := '+'. |
|
1320 ] |
|
1321 ]. |
|
1322 ] |
|
1323 ] ifTrue:[ "sawExcla" |
|
1324 |done first p className cls text methodPos |
|
1325 singleJunkOnly methodChunks singleInfo| |
|
1326 |
|
1327 singleJunkOnly := false. |
|
1328 methodChunks := false. |
|
1329 singleInfo := false. |
|
1330 |
|
1331 " |
|
1332 method definitions actually consist of |
|
1333 two (or more) chunks; skip next chunk(s) |
|
1334 up to an empty one. |
|
1335 The system only writes one chunk, |
|
1336 and we cannot handle more in this ChangesBrowser .... |
|
1337 " |
|
1338 className := nil. |
|
1339 p := Parser parseExpression:chunkText inNameSpace:Smalltalk. |
|
1340 |
|
1341 (p notNil and:[p ~~ #Error]) ifTrue:[ |
|
1342 sel := p selector. |
|
1343 (#( |
|
1344 #methodsFor: |
|
1345 #privateMethodsFor: |
|
1346 #publicMethodsFor: |
|
1347 #ignoredMethodsFor: |
|
1348 #protectedMethodsFor: |
|
1349 #methodsFor:stamp: "/ Squeak support |
|
1350 #'commentStamp:prior:' |
|
1351 ) |
|
1352 includes:sel) ifTrue:[ |
|
1353 methodChunks := true. |
|
1354 p receiver isUnaryMessage ifTrue:[ |
|
1355 className := p receiver receiver name. |
|
1356 changeClass := (Smalltalk classNamed:className) class. |
|
1357 className := className , ' class'. |
|
1358 ] ifFalse:[ |
|
1359 className := p receiver name. |
|
1360 changeClass := Smalltalk classNamed:className |
|
1361 ]. |
|
1362 category := (p args at:1) evaluate. |
|
1363 |
|
1364 sel == #'methodsFor:stamp:' ifTrue:[ |
|
1365 "/ Squeak timeStamp |
|
1366 timeStampInfo := (p args at:2) evaluate. |
|
1367 singleInfo := true |
|
1368 ] ifFalse:[ |
|
1369 sel == #'commentStamp:prior:' ifTrue:[ |
|
1370 singleJunkOnly := true. |
|
1371 methodChunks := false. |
|
1372 ]. |
|
1373 ] |
|
1374 ]. |
|
1375 ]. |
|
1376 |
|
1377 done := false. |
|
1378 first := true. |
|
1379 [done] whileFalse:[ |
|
1380 changeDelta := ' '. |
|
1381 methodPos := aStream position. |
|
1382 |
|
1383 text := aStream nextChunk. |
|
1384 text isNil ifTrue:[ |
|
1385 done := true |
|
1386 ] ifFalse:[ |
|
1387 done := text isEmpty |
|
1388 ]. |
|
1389 done ifFalse:[ |
|
1390 first ifFalse:[ |
|
1391 changeChunks add:chunkText. |
|
1392 changePositions add:methodPos. |
|
1393 changeTimeStamps add:timeStampInfo. |
|
1394 changeIsFollowupMethodChange add:true. |
|
1395 editingClassSource := true. |
|
1396 ]. |
|
1397 |
|
1398 first := false. |
|
1399 " |
|
1400 try to find the selector |
|
1401 " |
|
1402 sel := nil. |
|
1403 className notNil ifTrue:[ |
|
1404 methodChunks ifTrue:[ |
|
1405 p := Parser |
|
1406 parseMethodSpecification:text |
|
1407 in:nil |
|
1408 ignoreErrors:true |
|
1409 ignoreWarnings:true. |
|
1410 (p notNil and:[p ~~ #Error]) ifTrue:[ |
|
1411 sel := p selector. |
|
1412 ] |
|
1413 ] |
|
1414 ]. |
|
1415 |
|
1416 sel isNil ifTrue:[ |
|
1417 changeString := (chunkText contractTo:maxLen). |
|
1418 changeType := '(change)'. |
|
1419 headerLine := chunkText , ' (change)'. |
|
1420 ] ifFalse:[ |
|
1421 changeString := self contractClass:className selector:sel to:maxLen. |
|
1422 changeType := '(method in: ''' , category , ''')'. |
|
1423 headerLine := className , ' ' , sel , ' ' , '(change category: ''' , category , ''')'. |
|
1424 ]. |
|
1425 |
|
1426 compareChanges ifTrue:[ |
|
1427 changeClass isNil ifFalse:[ |
|
1428 changeClass isMeta ifTrue:[ |
|
1429 cls := changeClass soleInstance |
|
1430 ] ifFalse:[ |
|
1431 cls := changeClass |
|
1432 ]. |
|
1433 ]. |
|
1434 |
|
1435 (changeClass isNil or:[cls isLoaded not]) ifTrue:[ |
|
1436 changeDelta := '?' |
|
1437 ] ifFalse:[ |
|
1438 (changeClass implements:sel asSymbol) ifFalse:[ |
|
1439 changeDelta := '+'. |
|
1440 ] ifTrue:[ |
|
1441 |m currentText t1 t2| |
|
1442 |
|
1443 m := changeClass compiledMethodAt:sel asSymbol. |
|
1444 currentText := m source. |
|
1445 currentText notNil ifTrue:[ |
|
1446 text asString = currentText asString ifTrue:[ |
|
1447 changeDelta := '=' |
|
1448 ] ifFalse:[ |
|
1449 t1 := currentText asCollectionOfLines collect:[:s | s withTabsExpanded]. |
|
1450 t2 := text asCollectionOfLines collect:[:s | s withTabsExpanded]. |
|
1451 t1 = t2 ifTrue:[ |
|
1452 changeDelta := '=' |
|
1453 ] |
|
1454 ] |
|
1455 ] |
|
1456 ] |
|
1457 ] |
|
1458 ]. |
|
1459 entry := MultiColListEntry new. |
|
1460 entry tabulatorSpecification:tabSpec. |
|
1461 entry colAt:1 put:changeDelta. |
|
1462 entry colAt:2 put:changeString. |
|
1463 entry colAt:3 put:changeType. |
|
1464 timeStampInfo notNil ifTrue:[ |
|
1465 entry colAt:4 put:timeStampInfo. |
|
1466 ]. |
|
1467 changeHeaderLines add:entry |
|
1468 ]. |
|
1469 changeString := nil. |
|
1470 headerLine := nil. |
|
1471 singleJunkOnly ifTrue:[done := true] |
|
1472 ]. |
|
1473 singleInfo ifTrue:[ |
|
1474 timeStampInfo := nil |
|
1475 ]. |
|
1476 ]. |
|
1477 changeString notNil ifTrue:[ |
|
1478 entry := MultiColListEntry new. |
|
1479 entry tabulatorSpecification:tabSpec. |
|
1480 entry colAt:1 put:changeDelta. |
|
1481 entry colAt:2 put:changeString. |
|
1482 entry colAt:3 put:changeType. |
|
1483 timeStampInfo notNil ifTrue:[ |
|
1484 entry colAt:4 put:timeStampInfo. |
|
1485 ]. |
|
1486 changeHeaderLines add:entry |
|
1487 ] ifFalse:[ |
|
1488 headerLine notNil ifTrue:[ |
|
1489 changeHeaderLines add:headerLine |
|
1490 ] |
|
1491 ] |
|
1492 ] |
|
1493 ] |
|
1494 ]. |
|
1495 changeClassNames := OrderedCollection new grow:(changeChunks size). |
|
1496 anyChanges := false |
|
1497 ] valueNowOrOnUnwindDo:[ |
|
1498 aStream close. |
|
1499 inBackground ifTrue:[myProcess priority:myPriority]. |
|
1500 ]. |
|
1501 ]. |
|
1502 |
|
1503 self checkIfFileHasChanged |
|
1504 |
|
1505 "Modified: / 27.8.1995 / 23:06:55 / claus" |
|
1506 "Modified: / 17.7.1998 / 11:10:07 / cg" |
|
1507 ! |
|
1508 |
|
1509 writeBackChanges |
|
1510 "write back the changes file. To avoid problems when the disk is full |
|
1511 or a crash occurs while writing (well, or someone kills us), |
|
1512 first write the stuff to a new temporary file. If this works ok, |
|
1513 rename the old change-file to a .bak file and finally rename the |
|
1514 tempfile back to the change-file. |
|
1515 That way, if anything happens, either the original file is left unchanged, |
|
1516 or we have at least a backup of the previous change file." |
|
1517 |
|
1518 |inStream outStream tempfile stamp f| |
|
1519 |
|
1520 editingClassSource ifTrue:[ |
|
1521 (self confirm:'You are editing a classes sourceFile (not a changeFile) !!\\Are you certain, you want to overwrite it ?' withCRs) |
|
1522 ifFalse:[ |
|
1523 ^ false |
|
1524 ] |
|
1525 ]. |
|
1526 |
|
1527 tempfile := Filename newTemporaryIn:nil. |
|
1528 tempfile exists ifTrue:[tempfile remove]. |
|
1529 |
|
1530 outStream := tempfile writeStream. |
|
1531 outStream isNil ifTrue:[ |
|
1532 self warn:'cannot create temporary file in current directory.'. |
|
1533 ^ false |
|
1534 ]. |
|
1535 |
|
1536 inStream := FileStream readonlyFileNamed:changeFileName. |
|
1537 inStream isNil ifTrue:[^ false]. |
|
1538 |
|
1539 self withCursor:(Cursor write) do:[ |
|
1540 |excla sawExcla done first chunk |
|
1541 nChanges "{Class:SmallInteger}" | |
|
1542 |
|
1543 Stream writeErrorSignal handle:[:ex | |
|
1544 self warn:('could not update the changes file.\\' , ex errorString) withCRs. |
|
1545 tempfile exists ifTrue:[tempfile remove]. |
|
1546 ^ false |
|
1547 ] do:[ |
|
1548 |
|
1549 excla := inStream class chunkSeparator. |
|
1550 nChanges := self numberOfChanges. |
|
1551 |
|
1552 1 to:nChanges do:[:index | |
|
1553 inStream position:(changePositions at:index). |
|
1554 sawExcla := inStream peekFor:excla. |
|
1555 chunk := inStream nextChunk. |
|
1556 |
|
1557 (chunk notNil |
|
1558 and:[(chunk startsWith:'''---- snap') not]) ifTrue:[ |
|
1559 (stamp := changeTimeStamps at:index) notNil ifTrue:[ |
|
1560 outStream nextPutAll:'''---- timestamp ' , stamp , ' ----'''. |
|
1561 outStream nextPut:excla; cr. |
|
1562 ]. |
|
1563 ]. |
|
1564 |
|
1565 sawExcla ifTrue:[ |
|
1566 outStream nextPut:excla. |
|
1567 outStream nextChunkPut:chunk. |
|
1568 outStream cr; cr. |
|
1569 " |
|
1570 a method-definition chunk - output followups |
|
1571 " |
|
1572 done := false. |
|
1573 first := true. |
|
1574 [done] whileFalse:[ |
|
1575 chunk := inStream nextChunk. |
|
1576 chunk isNil ifTrue:[ |
|
1577 outStream cr; cr. |
|
1578 done := true |
|
1579 ] ifFalse:[ |
|
1580 chunk isEmpty ifTrue:[ |
|
1581 outStream space; nextChunkPut:chunk; cr; cr. |
|
1582 done := true. |
|
1583 ] ifFalse:[ |
|
1584 first ifFalse:[ |
|
1585 outStream cr; cr. |
|
1586 ]. |
|
1587 outStream nextChunkPut:chunk. |
|
1588 ]. |
|
1589 ]. |
|
1590 first := false. |
|
1591 ]. |
|
1592 ] ifFalse:[ |
|
1593 outStream nextChunkPut:chunk. |
|
1594 outStream cr |
|
1595 ] |
|
1596 ]. |
|
1597 outStream close. |
|
1598 inStream close. |
|
1599 ]. |
|
1600 |
|
1601 f := changeFileName asFilename. |
|
1602 f renameTo:(f withSuffix:'bak'). |
|
1603 tempfile renameTo:changeFileName. |
|
1604 anyChanges := false |
|
1605 ]. |
|
1606 ^ true |
|
1607 |
|
1608 "Modified: / 2.12.1996 / 22:29:15 / stefan" |
|
1609 "Modified: / 21.4.1998 / 17:50:11 / cg" |
|
1610 ! ! |
|
1611 |
|
1612 !ChangesBrowser methodsFor:'private-user interaction ops'! |
|
1613 |
547 appendChange:changeNr toFile:fileName |
1614 appendChange:changeNr toFile:fileName |
548 "append change to a file. return true if ok." |
1615 "append change to a file. return true if ok." |
549 |
1616 |
550 |aStream outStream chunk sawExcla separator| |
1617 |aStream outStream chunk sawExcla separator| |
551 |
1618 |
967 |
1930 |
968 aStream := FileStream readonlyFileNamed:changeFileName. |
1931 aStream := FileStream readonlyFileNamed:changeFileName. |
969 aStream isNil ifTrue:[^ self]. |
1932 aStream isNil ifTrue:[^ self]. |
970 |
1933 |
971 aClassNameOrNil isNil ifTrue:[ |
1934 aClassNameOrNil isNil ifTrue:[ |
972 self newLabel:'compressing ...'. |
1935 self newLabel:'compressing ...'. |
973 ] ifFalse:[ |
1936 ] ifFalse:[ |
974 self newLabel:'compressing for ' , aClassNameOrNil. |
1937 self newLabel:'compressing for ' , aClassNameOrNil. |
975 ]. |
1938 ]. |
976 |
1939 |
977 CompressSnapshotInfo == true ifTrue:[ |
1940 CompressSnapshotInfo == true ifTrue:[ |
978 " |
1941 " |
979 get a prototype snapshot record (to be independent of |
1942 get a prototype snapshot record (to be independent of |
980 the actual format .. |
1943 the actual format .. |
981 " |
1944 " |
982 str := WriteStream on:String new. |
1945 str := WriteStream on:String new. |
983 Class addChangeRecordForSnapshot:'foo' to:str. |
1946 Class addChangeRecordForSnapshot:'foo' to:str. |
984 snapshotProto := str contents. |
1947 snapshotProto := str contents. |
985 snapshotPrefix := snapshotProto copyTo:10. |
1948 snapshotPrefix := snapshotProto copyTo:10. |
986 snapshotNameIndex := snapshotProto findString:'foo'. |
1949 snapshotNameIndex := snapshotProto findString:'foo'. |
987 ]. |
1950 ]. |
988 |
1951 |
989 self withExecuteCursorDo:[ |
1952 self withExecuteCursorDo:[ |
990 |numChanges classes selectors types excla sawExcla |
1953 |numChanges classes selectors types excla sawExcla |
991 changeNr chunk aParseTree parseTreeChunk |
1954 changeNr chunk aParseTree parseTreeChunk |
992 thisClass thisSelector codeChunk codeParser |
1955 thisClass thisSelector codeChunk codeParser |
993 compressThis| |
1956 compressThis| |
994 |
1957 |
995 numChanges := self numberOfChanges. |
1958 numChanges := self numberOfChanges. |
996 classes := Array new:numChanges. |
1959 classes := Array new:numChanges. |
997 selectors := Array new:numChanges. |
1960 selectors := Array new:numChanges. |
998 types := Array new:numChanges. |
1961 types := Array new:numChanges. |
999 |
1962 |
1000 "starting at the end, get the change class and change selector; |
1963 "starting at the end, get the change class and change selector; |
1001 collect all in classes / selectors" |
1964 collect all in classes / selectors" |
1002 |
1965 |
1003 changeNr := numChanges. |
1966 changeNr := numChanges. |
1004 excla := aStream class chunkSeparator. |
1967 excla := aStream class chunkSeparator. |
1005 |
1968 |
1006 [changeNr >= 1] whileTrue:[ |
1969 [changeNr >= 1] whileTrue:[ |
1007 aStream position:(changePositions at:changeNr). |
1970 aStream position:(changePositions at:changeNr). |
1008 sawExcla := aStream peekFor:excla. |
1971 sawExcla := aStream peekFor:excla. |
1009 chunk := aStream nextChunk. |
1972 chunk := aStream nextChunk. |
1010 sawExcla ifTrue:[ |
1973 sawExcla ifTrue:[ |
1011 "optimize a bit if multiple methods for same category arrive" |
1974 "optimize a bit if multiple methods for same category arrive" |
1012 (chunk = parseTreeChunk) ifFalse:[ |
1975 (chunk = parseTreeChunk) ifFalse:[ |
1013 aParseTree := Parser parseExpression:chunk. |
1976 aParseTree := Parser parseExpression:chunk. |
1014 parseTreeChunk := chunk |
1977 parseTreeChunk := chunk |
1015 ]. |
1978 ]. |
1016 (aParseTree notNil |
1979 (aParseTree notNil |
1017 and:[(aParseTree ~~ #Error) |
1980 and:[(aParseTree ~~ #Error) |
1018 and:[aParseTree isMessage]]) ifTrue:[ |
1981 and:[aParseTree isMessage]]) ifTrue:[ |
1019 (aParseTree selector == #methodsFor:) ifTrue:[ |
1982 (#( |
1020 thisClass := (aParseTree receiver evaluate). |
1983 #methodsFor: |
1021 codeChunk := aStream nextChunk. |
1984 #privateMethodsFor: |
1022 codeParser := Parser |
1985 #publicMethodsFor: |
1023 parseMethodSpecification:codeChunk |
1986 #ignoredMethodsFor: |
1024 in:thisClass |
1987 #protectedMethodsFor: |
1025 ignoreErrors:true |
1988 #methodsFor:stamp: "/ Squeak support |
1026 ignoreWarnings:true. |
1989 ) |
1027 (codeParser notNil and:[codeParser ~~ #Error]) ifTrue:[ |
1990 includes:aParseTree selector) ifTrue:[ |
1028 selectors at:changeNr put:(codeParser selector). |
1991 thisClass := (aParseTree receiver evaluate). |
1029 classes at:changeNr put:thisClass. |
1992 codeChunk := aStream nextChunk. |
1030 types at:changeNr put:#methodsFor |
1993 codeParser := Parser |
1031 ] |
1994 parseMethodSpecification:codeChunk |
1032 ] |
1995 in:thisClass |
1033 ] |
1996 ignoreErrors:true |
1034 ] ifFalse:[ |
1997 ignoreWarnings:true. |
1035 aParseTree := Parser parseExpression:chunk. |
1998 (codeParser notNil and:[codeParser ~~ #Error]) ifTrue:[ |
1036 parseTreeChunk := chunk. |
1999 selectors at:changeNr put:(codeParser selector). |
1037 (aParseTree notNil |
2000 classes at:changeNr put:thisClass. |
1038 and:[(aParseTree ~~ #Error) |
2001 types at:changeNr put:#methodsFor |
1039 and:[aParseTree isMessage]]) ifTrue:[ |
2002 ] |
1040 (aParseTree selector == #removeSelector:) ifTrue:[ |
2003 ] |
1041 selectors at:changeNr put:(aParseTree arg1 value ). |
2004 ] |
1042 classes at:changeNr put:(aParseTree receiver evaluate). |
2005 ] ifFalse:[ |
1043 types at:changeNr put:#removeSelector |
2006 aParseTree := Parser parseExpression:chunk. |
1044 ] |
2007 parseTreeChunk := chunk. |
1045 ] ifFalse:[ |
2008 (aParseTree notNil |
1046 CompressSnapshotInfo == true ifTrue:[ |
2009 and:[(aParseTree ~~ #Error) |
1047 (chunk startsWith:snapshotPrefix) ifTrue:[ |
2010 and:[aParseTree isMessage]]) ifTrue:[ |
1048 str := chunk readStream position:snapshotNameIndex. |
2011 (aParseTree selector == #removeSelector:) ifTrue:[ |
1049 fileName := str upTo:(Character space). |
2012 selectors at:changeNr put:(aParseTree arg1 value ). |
1050 " |
2013 classes at:changeNr put:(aParseTree receiver evaluate). |
1051 kludge to allow use of match-check below |
2014 types at:changeNr put:#removeSelector |
1052 " |
2015 ] |
1053 selectors at:changeNr put:snapshotPrefix. |
2016 ] ifFalse:[ |
1054 classes at:changeNr put:fileName. |
2017 CompressSnapshotInfo == true ifTrue:[ |
1055 ] |
2018 (chunk startsWith:snapshotPrefix) ifTrue:[ |
1056 ] |
2019 str := chunk readStream position:snapshotNameIndex. |
1057 ] |
2020 fileName := str upTo:(Character space). |
1058 ]. |
2021 " |
1059 changeNr := changeNr - 1 |
2022 kludge to allow use of match-check below |
1060 ]. |
2023 " |
1061 aStream close. |
2024 selectors at:changeNr put:snapshotPrefix. |
1062 |
2025 classes at:changeNr put:fileName. |
1063 "for all changes, look for another class/selector occurence later |
2026 ] |
1064 in the list and, if there is one, add change number to the delete set" |
2027 ] |
1065 |
2028 ] |
1066 deleteSet := OrderedCollection new. |
2029 ]. |
1067 changeNr := 1. |
2030 changeNr := changeNr - 1 |
1068 [changeNr < self numberOfChanges] whileTrue:[ |
2031 ]. |
1069 thisClass := classes at:changeNr. |
2032 aStream close. |
1070 |
2033 |
1071 compressThis := false. |
2034 "for all changes, look for another class/selector occurence later |
1072 aClassNameOrNil isNil ifTrue:[ |
2035 in the list and, if there is one, add change number to the delete set" |
1073 compressThis := true |
2036 |
1074 ] ifFalse:[ |
2037 deleteSet := OrderedCollection new. |
1075 "/ skipping unloaded/unknown classes |
2038 changeNr := 1. |
1076 thisClass isBehavior ifTrue:[ |
2039 [changeNr < self numberOfChanges] whileTrue:[ |
1077 thisClass isMeta ifTrue:[ |
2040 thisClass := classes at:changeNr. |
1078 compressThis := aClassNameOrNil = thisClass soleInstance name. |
2041 |
1079 ] ifFalse:[ |
2042 compressThis := false. |
1080 compressThis := aClassNameOrNil = thisClass name |
2043 aClassNameOrNil isNil ifTrue:[ |
1081 ] |
2044 compressThis := true |
1082 ] |
2045 ] ifFalse:[ |
1083 ]. |
2046 "/ skipping unloaded/unknown classes |
1084 |
2047 thisClass isBehavior ifTrue:[ |
1085 compressThis ifTrue:[ |
2048 thisClass isMeta ifTrue:[ |
1086 thisSelector := selectors at:changeNr. |
2049 compressThis := aClassNameOrNil = thisClass soleInstance name. |
1087 searchIndex := changeNr. |
2050 ] ifFalse:[ |
1088 anyMore := true. |
2051 compressThis := aClassNameOrNil = thisClass name |
1089 [anyMore] whileTrue:[ |
2052 ] |
1090 searchIndex := classes indexOf:thisClass |
2053 ] |
1091 startingAt:(searchIndex + 1). |
2054 ]. |
1092 (searchIndex ~~ 0) ifTrue:[ |
2055 |
1093 ((selectors at:searchIndex) == thisSelector) ifTrue:[ |
2056 compressThis ifTrue:[ |
1094 thisClass notNil ifTrue:[ |
2057 thisSelector := selectors at:changeNr. |
1095 deleteSet add:changeNr. |
2058 searchIndex := changeNr. |
1096 anyMore := false |
2059 anyMore := true. |
1097 ] |
2060 [anyMore] whileTrue:[ |
1098 ] |
2061 searchIndex := classes indexOf:thisClass |
1099 ] ifFalse:[ |
2062 startingAt:(searchIndex + 1). |
1100 anyMore := false |
2063 (searchIndex ~~ 0) ifTrue:[ |
1101 ] |
2064 ((selectors at:searchIndex) == thisSelector) ifTrue:[ |
1102 ]. |
2065 thisClass notNil ifTrue:[ |
1103 ]. |
2066 deleteSet add:changeNr. |
1104 |
2067 anyMore := false |
1105 changeNr := changeNr + 1 |
2068 ] |
1106 ]. |
2069 ] |
1107 |
2070 ] ifFalse:[ |
1108 "finally delete what has been found" |
2071 anyMore := false |
1109 |
2072 ] |
1110 (deleteSet size > 0) ifTrue:[ |
2073 ]. |
1111 changeListView setSelection:nil. |
2074 ]. |
1112 index := deleteSet size. |
2075 |
1113 [index > 0] whileTrue:[ |
2076 changeNr := changeNr + 1 |
1114 self silentDeleteChange:(deleteSet at:index). |
2077 ]. |
1115 index := index - 1 |
2078 |
1116 ]. |
2079 "finally delete what has been found" |
1117 self setChangeList. |
2080 |
1118 " |
2081 (deleteSet size > 0) ifTrue:[ |
1119 scroll back a bit, if we are left way behind the list |
2082 changeListView setSelection:nil. |
1120 " |
2083 index := deleteSet size. |
1121 changeListView firstLineShown > self numberOfChanges ifTrue:[ |
2084 [index > 0] whileTrue:[ |
1122 changeListView makeLineVisible:self numberOfChanges |
2085 self silentDeleteChange:(deleteSet at:index). |
1123 ]. |
2086 index := index - 1 |
1124 self clearCodeView |
2087 ]. |
1125 ] |
2088 self setChangeList. |
|
2089 " |
|
2090 scroll back a bit, if we are left way behind the list |
|
2091 " |
|
2092 changeListView firstLineShown > self numberOfChanges ifTrue:[ |
|
2093 changeListView makeLineVisible:self numberOfChanges |
|
2094 ]. |
|
2095 self clearCodeView |
|
2096 ] |
1126 ]. |
2097 ]. |
1127 self newLabel:''. |
2098 self newLabel:''. |
1128 |
2099 |
1129 "Created: / 29.10.1997 / 01:02:44 / cg" |
2100 "Created: / 29.10.1997 / 01:02:44 / cg" |
1130 "Modified: / 29.10.1997 / 01:26:59 / cg" |
2101 "Modified: / 29.10.1997 / 01:26:59 / cg" |
1131 ! |
|
1132 |
|
1133 contractClass:className selector:selector to:maxLen |
|
1134 |s l| |
|
1135 |
|
1136 s := className , ' ', selector. |
|
1137 s size > maxLen ifTrue:[ |
|
1138 l := maxLen - 1 - selector size max:20. |
|
1139 s := (className contractTo:l) , ' ' , selector. |
|
1140 |
|
1141 s size > maxLen ifTrue:[ |
|
1142 l := maxLen - 1 - className size max:20. |
|
1143 s := className , ' ', (selector contractTo:l). |
|
1144 |
|
1145 s size > maxLen ifTrue:[ |
|
1146 s := (className contractTo:(maxLen // 2 - 1)) , ' ' , (selector contractTo:maxLen // 2) |
|
1147 ] |
|
1148 ] |
|
1149 ]. |
|
1150 ^ s |
|
1151 ! |
2102 ! |
1152 |
2103 |
1153 deleteChange:changeNr |
2104 deleteChange:changeNr |
1154 "delete a change" |
2105 "delete a change" |
1155 |
2106 |
1171 "/ self setChangeList |
2122 "/ self setChangeList |
1172 |
2123 |
1173 "Modified: / 18.5.1998 / 14:22:27 / cg" |
2124 "Modified: / 18.5.1998 / 14:22:27 / cg" |
1174 ! |
2125 ! |
1175 |
2126 |
1176 fullClassNameOfChange:changeNr |
|
1177 "return the full classname of a change |
|
1178 (for classChanges (i.e. xxx class), a string ending in ' class' is returned. |
|
1179 - since parsing ascii methods is slow, keep result cached in |
|
1180 changeClassNames for the next query" |
|
1181 |
|
1182 |chunk aParseTree recTree sel name arg1Tree isMeta prevMethodDefNr |
|
1183 words changeStream fullParseTree ownerTree ownerName oldDollarSetting| |
|
1184 |
|
1185 changeNr isNil ifTrue:[^ nil]. |
|
1186 |
|
1187 " |
|
1188 first look, if not already known |
|
1189 " |
|
1190 name := changeClassNames at:changeNr. |
|
1191 name notNil ifTrue:[^ name]. |
|
1192 |
|
1193 prevMethodDefNr := changeNr. |
|
1194 [changeIsFollowupMethodChange at:prevMethodDefNr] whileTrue:[ |
|
1195 prevMethodDefNr := prevMethodDefNr - 1. |
|
1196 ]. |
|
1197 |
|
1198 " |
|
1199 get the chunk |
|
1200 " |
|
1201 chunk := changeChunks at:prevMethodDefNr. |
|
1202 chunk isNil ifTrue:[^ nil]. "mhmh - empty" |
|
1203 |
|
1204 (chunk startsWith:'''---') ifTrue:[ |
|
1205 words := chunk asCollectionOfWords. |
|
1206 words size > 2 ifTrue:[ |
|
1207 (words at:2) = 'checkin' ifTrue:[ |
|
1208 name := words at:3. |
|
1209 changeClassNames at:changeNr put:name. |
|
1210 ^ name |
|
1211 ] |
|
1212 ]. |
|
1213 ]. |
|
1214 |
|
1215 "/ fix it - otherwise, it cannot be parsed |
|
1216 (chunk endsWith:'primitiveDefinitions:') ifTrue:[ |
|
1217 chunk := chunk , '''''' |
|
1218 ]. |
|
1219 (chunk endsWith:'primitiveFunctions:') ifTrue:[ |
|
1220 chunk := chunk , '''''' |
|
1221 ]. |
|
1222 (chunk endsWith:'primitiveVariables:') ifTrue:[ |
|
1223 chunk := chunk , '''''' |
|
1224 ]. |
|
1225 |
|
1226 " |
|
1227 use parser to construct a parseTree |
|
1228 " |
|
1229 oldDollarSetting := Parser allowDollarInIdentifier. |
|
1230 [ |
|
1231 Parser allowDollarInIdentifier:true. |
|
1232 aParseTree := Parser parseExpression:chunk. |
|
1233 |
|
1234 aParseTree == #Error ifTrue:[ |
|
1235 (chunk includesString:'comment') ifTrue:[ |
|
1236 "/ could be a comment ... |
|
1237 aParseTree := Parser parseExpression:chunk , ''''. |
|
1238 ] |
|
1239 ]. |
|
1240 ] valueNowOrOnUnwindDo:[ |
|
1241 Parser allowDollarInIdentifier:oldDollarSetting |
|
1242 ]. |
|
1243 |
|
1244 (aParseTree isNil or:[aParseTree == #Error]) ifTrue:[ |
|
1245 ^ nil "seems strange ... (could be a comment)" |
|
1246 ]. |
|
1247 aParseTree isMessage ifFalse:[ |
|
1248 ^ nil "very strange ... (whats that ?)" |
|
1249 ]. |
|
1250 |
|
1251 " |
|
1252 ask parser for selector |
|
1253 " |
|
1254 sel := aParseTree selector. |
|
1255 recTree := aParseTree receiver. |
|
1256 |
|
1257 " |
|
1258 is it a method-change, methodRemove or comment-change ? |
|
1259 " |
|
1260 (#(#'methodsFor:' |
|
1261 #'privateMethodsFor:' |
|
1262 #'protectedMethodsFor:' |
|
1263 #'ignoredMethodsFor:' |
|
1264 #'publicMethodsFor:' |
|
1265 #'removeSelector:' |
|
1266 #'comment:' |
|
1267 #'primitiveDefinitions:' |
|
1268 #'primitiveFunctions:' |
|
1269 #'primitiveVariables:' |
|
1270 #'renameCategory:to:' |
|
1271 #'instanceVariableNames:' |
|
1272 ) includes:sel) ifTrue:[ |
|
1273 " |
|
1274 yes, the className is the receiver |
|
1275 " |
|
1276 (recTree notNil and:[recTree ~~ #Error]) ifTrue:[ |
|
1277 isMeta := false. |
|
1278 recTree isUnaryMessage ifTrue:[ |
|
1279 (recTree selector ~~ #class) ifTrue:[^ nil]. |
|
1280 "id class methodsFor:..." |
|
1281 recTree := recTree receiver. |
|
1282 isMeta := true. |
|
1283 ]. |
|
1284 recTree isPrimary ifTrue:[ |
|
1285 name := recTree name. |
|
1286 isMeta ifTrue:[ |
|
1287 name := name , ' class'. |
|
1288 ]. |
|
1289 changeClassNames at:changeNr put:name. |
|
1290 ^ name |
|
1291 ] |
|
1292 ]. |
|
1293 "more strange things" |
|
1294 ^ nil |
|
1295 ]. |
|
1296 |
|
1297 " |
|
1298 is it a change in a class-description ? |
|
1299 " |
|
1300 (('subclass:*' match:sel) |
|
1301 or:[('variable*subclass:*' match:sel)]) ifTrue:[ |
|
1302 "/ must parse the full changes text, to get |
|
1303 "/ privacy information. |
|
1304 |
|
1305 changeStream := self streamForChange:changeNr. |
|
1306 changeStream notNil ifTrue:[ |
|
1307 chunk := changeStream nextChunk. |
|
1308 changeStream close. |
|
1309 fullParseTree := Parser parseExpression:chunk. |
|
1310 (fullParseTree isNil or:[fullParseTree == #Error]) ifTrue:[ |
|
1311 fullParseTree := nil |
|
1312 ]. |
|
1313 fullParseTree isMessage ifFalse:[ |
|
1314 fullParseTree := nil |
|
1315 ]. |
|
1316 "/ actually, the nil case cannot happen |
|
1317 fullParseTree notNil ifTrue:[ |
|
1318 aParseTree := fullParseTree. |
|
1319 sel := aParseTree selector. |
|
1320 ]. |
|
1321 ]. |
|
1322 |
|
1323 arg1Tree := aParseTree arg1. |
|
1324 (arg1Tree notNil and:[arg1Tree isConstant]) ifTrue:[ |
|
1325 name := arg1Tree value asString. |
|
1326 |
|
1327 "/ is it a private-class ? |
|
1328 ('*privateIn:' match:sel) ifTrue:[ |
|
1329 ownerTree := aParseTree args last. |
|
1330 ownerName := ownerTree name asString. |
|
1331 name := ownerName , '::' , name |
|
1332 ]. |
|
1333 changeClassNames at:changeNr put:name. |
|
1334 ^ name |
|
1335 ]. |
|
1336 "very strange" |
|
1337 ^ nil |
|
1338 ]. |
|
1339 |
|
1340 " |
|
1341 is it a class remove ? |
|
1342 " |
|
1343 (sel == #removeClass:) ifTrue:[ |
|
1344 (recTree notNil |
|
1345 and:[recTree ~~ #Error |
|
1346 and:[recTree isPrimary |
|
1347 and:[recTree name = 'Smalltalk']]]) ifTrue:[ |
|
1348 arg1Tree := aParseTree arg1. |
|
1349 (arg1Tree notNil and:[arg1Tree isPrimary]) ifTrue:[ |
|
1350 name := arg1Tree name. |
|
1351 changeClassNames at:changeNr put:name. |
|
1352 ^ name |
|
1353 ]. |
|
1354 ] |
|
1355 ]. |
|
1356 |
|
1357 " |
|
1358 is it a method category change ? |
|
1359 " |
|
1360 ((sel == #category:) |
|
1361 or:[sel == #privacy:]) ifTrue:[ |
|
1362 (recTree notNil |
|
1363 and:[recTree ~~ #Error |
|
1364 and:[recTree isMessage |
|
1365 and:[recTree selector == #compiledMethodAt:]]]) ifTrue:[ |
|
1366 isMeta := false. |
|
1367 recTree := recTree receiver. |
|
1368 recTree isUnaryMessage ifTrue:[ |
|
1369 (recTree selector ~~ #class) ifTrue:[^ nil]. |
|
1370 "id class " |
|
1371 recTree := recTree receiver |
|
1372 ]. |
|
1373 recTree isPrimary ifTrue:[ |
|
1374 isMeta ifTrue:[ |
|
1375 name := name , ' class'. |
|
1376 ]. |
|
1377 name := recTree name. |
|
1378 changeClassNames at:changeNr put:name. |
|
1379 ^ name |
|
1380 ] |
|
1381 ] |
|
1382 ]. |
|
1383 ^ nil |
|
1384 |
|
1385 "Modified: / 3.8.1998 / 19:58:17 / cg" |
|
1386 ! |
|
1387 |
|
1388 makeChangeAPatch:changeNr |
2127 makeChangeAPatch:changeNr |
1389 "append change to patchfile" |
2128 "append change to patchfile" |
1390 |
2129 |
1391 self appendChange:changeNr toFile:'patches' |
2130 self appendChange:changeNr toFile:'patches' |
1392 ! |
2131 ! |
1393 |
2132 |
1394 makeChangePermanent:changeNr |
2133 makeChangePermanent:changeNr |
1395 "rewrite the source file where change changeNr lies" |
2134 "rewrite the source file where change changeNr lies" |
1396 |
2135 |
1397 self notify:'this is not yet implemented' |
2136 self notify:'this is not yet implemented' |
1398 ! |
|
1399 |
|
1400 newLabel:how |
|
1401 |l| |
|
1402 |
|
1403 (changeFileName ~= 'changes') ifTrue:[ |
|
1404 l := self class defaultLabel , ': ', changeFileName |
|
1405 ] ifFalse:[ |
|
1406 l := self class defaultLabel |
|
1407 ]. |
|
1408 l := l , ' ' , how. |
|
1409 self label:l |
|
1410 |
|
1411 "Created: / 8.9.1995 / 19:32:04 / claus" |
|
1412 "Modified: / 8.9.1995 / 19:39:29 / claus" |
|
1413 "Modified: / 6.2.1998 / 13:27:01 / cg" |
|
1414 ! |
|
1415 |
|
1416 numberOfChanges |
|
1417 ^ changePositions size |
|
1418 |
|
1419 "Created: 3.12.1995 / 18:15:39 / cg" |
|
1420 ! |
|
1421 |
|
1422 queryCloseText |
|
1423 "made this a method for easy redefinition in subclasses" |
|
1424 |
|
1425 ^ 'Quit without updating changeFile ?' |
|
1426 ! |
|
1427 |
|
1428 readChangesFile |
|
1429 "read the changes file, create a list of header-lines (changeChunks) |
|
1430 and a list of chunk-positions (changePositions)" |
|
1431 |
|
1432 ^ self readChangesFileInBackground:false |
|
1433 ! |
|
1434 |
|
1435 readChangesFileInBackground:inBackground |
|
1436 "read the changes file, create a list of header-lines (changeChunks) |
|
1437 and a list of chunk-positions (changePositions). |
|
1438 Starting with 2.10.3, the entries are multi-col entries; |
|
1439 the cols are: |
|
1440 1 delta (only if comparing) |
|
1441 '+' -> new method (w.r.t. current state) |
|
1442 '-' -> removed method (w.r.t. current state) |
|
1443 '?' -> class does not exist currently |
|
1444 '=' -> change is same as current methods source |
|
1445 2 class/selector |
|
1446 3 type of change |
|
1447 doit |
|
1448 method |
|
1449 category change |
|
1450 4 timestamp |
|
1451 |
|
1452 since comparing slows down startup time, it is now disabled by |
|
1453 default and can be enabled via a toggle." |
|
1454 |
|
1455 |aStream maxLen i f| |
|
1456 |
|
1457 editingClassSource := false. |
|
1458 |
|
1459 maxLen := 60. |
|
1460 |
|
1461 f := changeFileName asFilename. |
|
1462 aStream := f readStream. |
|
1463 aStream isNil ifTrue:[^ nil]. |
|
1464 |
|
1465 self newLabel:'updating ...'. |
|
1466 |
|
1467 i := f info. |
|
1468 changeFileSize := i size. |
|
1469 changeFileTimestamp := i modified. |
|
1470 |
|
1471 self withReadCursorDo:[ |
|
1472 |myProcess myPriority| |
|
1473 |
|
1474 " |
|
1475 this is a time consuming operation (especially, if reading an |
|
1476 NFS-mounted directory; therefore lower my priority ... |
|
1477 " |
|
1478 inBackground ifTrue:[ |
|
1479 myProcess := Processor activeProcess. |
|
1480 myPriority := myProcess priority. |
|
1481 myProcess priority:(Processor userBackgroundPriority). |
|
1482 ]. |
|
1483 |
|
1484 [ |
|
1485 |excla timeStampInfo| |
|
1486 |
|
1487 changeChunks := OrderedCollection new. |
|
1488 changeHeaderLines := OrderedCollection new. |
|
1489 changePositions := OrderedCollection new. |
|
1490 changeTimeStamps := OrderedCollection new. |
|
1491 changeIsFollowupMethodChange := OrderedCollection new. |
|
1492 |
|
1493 excla := aStream class chunkSeparator. |
|
1494 |
|
1495 [aStream atEnd] whileFalse:[ |
|
1496 |entry changeDelta changeString changeType |
|
1497 line s l changeClass sawExcla category |
|
1498 chunkText chunkPos sel| |
|
1499 |
|
1500 " |
|
1501 get a chunk (separated by excla) |
|
1502 " |
|
1503 aStream skipSeparators. |
|
1504 chunkPos := aStream position. |
|
1505 |
|
1506 |
|
1507 sawExcla := aStream peekFor:excla. |
|
1508 chunkText := aStream nextChunk. |
|
1509 chunkText notNil ifTrue:[ |
|
1510 |index headerLine cls| |
|
1511 |
|
1512 (chunkText startsWith:'''---- timestamp ') ifTrue:[ |
|
1513 timeStampInfo := (chunkText copyFrom:16 to:(chunkText size - 6)) withoutSpaces. |
|
1514 ] ifFalse:[ |
|
1515 |
|
1516 " |
|
1517 only first line is saved in changeChunks ... |
|
1518 " |
|
1519 index := chunkText indexOf:(Character cr). |
|
1520 (index ~~ 0) ifTrue:[ |
|
1521 chunkText := chunkText copyTo:(index - 1). |
|
1522 |
|
1523 "take care for comment changes - must still be a |
|
1524 valid expression for classNameOfChange: to work" |
|
1525 |
|
1526 (chunkText endsWith:'comment:''') ifTrue:[ |
|
1527 chunkText := chunkText , '...''' |
|
1528 ]. |
|
1529 (chunkText endsWith:'primitiveDefinitions:''') ifTrue:[ |
|
1530 sel := 'primitiveDefinitions:'. |
|
1531 chunkText := chunkText copyWithoutLast:1 |
|
1532 ]. |
|
1533 (chunkText endsWith:'primitiveVariables:''') ifTrue:[ |
|
1534 sel := 'primitiveVariables:'. |
|
1535 chunkText := chunkText copyWithoutLast:1 |
|
1536 ]. |
|
1537 (chunkText endsWith:'primitiveFunctions:''') ifTrue:[ |
|
1538 sel := 'primitiveFunctions:'. |
|
1539 chunkText := chunkText copyWithoutLast:1 |
|
1540 ]. |
|
1541 ]. |
|
1542 |
|
1543 changeChunks add:chunkText. |
|
1544 changePositions add:chunkPos. |
|
1545 changeTimeStamps add:timeStampInfo. |
|
1546 changeIsFollowupMethodChange add:false. |
|
1547 |
|
1548 headerLine := nil. |
|
1549 changeDelta := ' '. |
|
1550 |
|
1551 sawExcla ifFalse:[ |
|
1552 (chunkText startsWith:'''---- snap') ifTrue:[ |
|
1553 changeType := ''. |
|
1554 headerLine := chunkText. |
|
1555 changeString := (chunkText contractTo:maxLen). |
|
1556 timeStampInfo := nil. |
|
1557 ] ifFalse:[ |
|
1558 |
|
1559 |p cls clsName| |
|
1560 |
|
1561 headerLine := chunkText , ' (doIt)'. |
|
1562 |
|
1563 " |
|
1564 first, assume doIt - then lets have a more detailed look ... |
|
1565 " |
|
1566 ((chunkText startsWith:'''---- file') |
|
1567 or:[(chunkText startsWith:'''---- check')]) ifTrue:[ |
|
1568 changeType := ''. |
|
1569 timeStampInfo := nil. |
|
1570 ] ifFalse:[ |
|
1571 changeType := '(doIt)'. |
|
1572 ]. |
|
1573 changeString := (chunkText contractTo:maxLen). |
|
1574 |
|
1575 p := Parser parseExpression:chunkText inNameSpace:Smalltalk. |
|
1576 (p notNil |
|
1577 and:[p ~~ #Error |
|
1578 and:[p isMessage]]) ifTrue:[ |
|
1579 sel := p selector. |
|
1580 ] ifFalse:[ |
|
1581 sel := nil. |
|
1582 ]. |
|
1583 (sel == #removeSelector:) ifTrue:[ |
|
1584 p receiver isUnaryMessage ifTrue:[ |
|
1585 cls := p receiver receiver name. |
|
1586 changeClass := (Smalltalk classNamed:cls) class. |
|
1587 cls := cls , ' class'. |
|
1588 ] ifFalse:[ |
|
1589 cls := p receiver name. |
|
1590 changeClass := (Smalltalk classNamed:cls) |
|
1591 ]. |
|
1592 sel := (p args at:1) evaluate. |
|
1593 |
|
1594 compareChanges ifTrue:[ |
|
1595 (changeClass isNil or:[changeClass isLoaded not]) ifTrue:[ |
|
1596 changeDelta := '?' |
|
1597 ] ifFalse:[ |
|
1598 (changeClass implements:sel asSymbol) ifTrue:[ |
|
1599 changeDelta := '-'. |
|
1600 ] ifFalse:[ |
|
1601 changeDelta := '='. |
|
1602 ] |
|
1603 ] |
|
1604 ]. |
|
1605 changeType := '(remove)'. |
|
1606 changeString := self contractClass:cls selector:sel to:maxLen. |
|
1607 ]. |
|
1608 (p ~~ #Error |
|
1609 and:[p isMessage |
|
1610 and:[p receiver isMessage |
|
1611 and:[p receiver selector == #compiledMethodAt:]]]) ifTrue:[ |
|
1612 p receiver receiver isUnaryMessage ifTrue:[ |
|
1613 cls := p receiver receiver receiver name. |
|
1614 changeClass := (Smalltalk classNamed:cls) class. |
|
1615 cls := cls , ' class'. |
|
1616 ] ifFalse:[ |
|
1617 cls := p receiver receiver name. |
|
1618 changeClass := (Smalltalk classNamed:cls) |
|
1619 ]. |
|
1620 (sel == #category:) ifTrue:[ |
|
1621 sel := (p receiver args at:1) evaluate. |
|
1622 changeType := '(category change)'. |
|
1623 changeString := self contractClass:cls selector:sel to:maxLen. |
|
1624 ]. |
|
1625 (sel == #privacy:) ifTrue:[ |
|
1626 sel := (p receiver args at:1) evaluate. |
|
1627 changeType := '(privacy change)'. |
|
1628 changeString := self contractClass:cls selector:sel to:maxLen. |
|
1629 ]. |
|
1630 ]. |
|
1631 (#(#'subclass:' |
|
1632 #'variableSubclass:' |
|
1633 #'variableByteSubclass:' |
|
1634 #'variableWordSubclass:' |
|
1635 #'variableLongSubclass:' |
|
1636 #'variableFloatSubclass:' |
|
1637 #'variableDoubleSubclass:' |
|
1638 #'primitiveDefinitions:' |
|
1639 #'primitiveFunctions:' |
|
1640 #'primitiveVariables:' |
|
1641 ) includes:sel) ifTrue:[ |
|
1642 changeType := '(class definition)'. |
|
1643 clsName := (p args at:1) evaluate. |
|
1644 cls := Smalltalk at:clsName ifAbsent:nil. |
|
1645 cls isNil ifTrue:[ |
|
1646 changeDelta := '+'. |
|
1647 ] |
|
1648 ]. |
|
1649 ] |
|
1650 ] ifTrue:[ "sawExcla" |
|
1651 |done first p className cls text methodPos| |
|
1652 |
|
1653 " |
|
1654 method definitions actually consist of |
|
1655 two (or more) chunks; skip next chunk(s) |
|
1656 up to an empty one. |
|
1657 The system only writes one chunk, |
|
1658 and we cannot handle more in this ChangesBrowser .... |
|
1659 " |
|
1660 className := nil. |
|
1661 p := Parser parseExpression:chunkText inNameSpace:Smalltalk. |
|
1662 |
|
1663 (p notNil and:[p ~~ #Error]) ifTrue:[ |
|
1664 sel := p selector. |
|
1665 (sel == #methodsFor:) ifTrue:[ |
|
1666 p receiver isUnaryMessage ifTrue:[ |
|
1667 className := p receiver receiver name. |
|
1668 changeClass := (Smalltalk classNamed:className) class. |
|
1669 className := className , ' class'. |
|
1670 ] ifFalse:[ |
|
1671 className := p receiver name. |
|
1672 changeClass := Smalltalk classNamed:className |
|
1673 ]. |
|
1674 category := (p args at:1) evaluate. |
|
1675 ]. |
|
1676 ]. |
|
1677 |
|
1678 done := false. |
|
1679 first := true. |
|
1680 [done] whileFalse:[ |
|
1681 changeDelta := ' '. |
|
1682 methodPos := aStream position. |
|
1683 |
|
1684 text := aStream nextChunk. |
|
1685 text isNil ifTrue:[ |
|
1686 done := true |
|
1687 ] ifFalse:[ |
|
1688 done := text isEmpty |
|
1689 ]. |
|
1690 done ifFalse:[ |
|
1691 first ifFalse:[ |
|
1692 changeChunks add:chunkText. |
|
1693 changePositions add:methodPos. |
|
1694 changeTimeStamps add:timeStampInfo. |
|
1695 changeIsFollowupMethodChange add:true. |
|
1696 editingClassSource := true. |
|
1697 ]. |
|
1698 |
|
1699 first := false. |
|
1700 " |
|
1701 try to find the selector |
|
1702 " |
|
1703 sel := nil. |
|
1704 className notNil ifTrue:[ |
|
1705 p := Parser |
|
1706 parseMethodSpecification:text |
|
1707 in:nil |
|
1708 ignoreErrors:true |
|
1709 ignoreWarnings:true. |
|
1710 (p notNil and:[p ~~ #Error]) ifTrue:[ |
|
1711 sel := p selector. |
|
1712 ] |
|
1713 ]. |
|
1714 |
|
1715 sel isNil ifTrue:[ |
|
1716 changeString := (chunkText contractTo:maxLen). |
|
1717 changeType := '(change)'. |
|
1718 headerLine := chunkText , ' (change)'. |
|
1719 ] ifFalse:[ |
|
1720 changeString := self contractClass:className selector:sel to:maxLen. |
|
1721 changeType := '(method in: ''' , category , ''')'. |
|
1722 headerLine := className , ' ' , sel , ' ' , '(change category: ''' , category , ''')'. |
|
1723 ]. |
|
1724 |
|
1725 compareChanges ifTrue:[ |
|
1726 changeClass isNil ifFalse:[ |
|
1727 changeClass isMeta ifTrue:[ |
|
1728 cls := changeClass soleInstance |
|
1729 ] ifFalse:[ |
|
1730 cls := changeClass |
|
1731 ]. |
|
1732 ]. |
|
1733 |
|
1734 (changeClass isNil or:[cls isLoaded not]) ifTrue:[ |
|
1735 changeDelta := '?' |
|
1736 ] ifFalse:[ |
|
1737 (changeClass implements:sel asSymbol) ifFalse:[ |
|
1738 changeDelta := '+'. |
|
1739 ] ifTrue:[ |
|
1740 |m currentText t1 t2| |
|
1741 |
|
1742 m := changeClass compiledMethodAt:sel asSymbol. |
|
1743 currentText := m source. |
|
1744 currentText notNil ifTrue:[ |
|
1745 text asString = currentText asString ifTrue:[ |
|
1746 changeDelta := '=' |
|
1747 ] ifFalse:[ |
|
1748 t1 := currentText asCollectionOfLines collect:[:s | s withTabsExpanded]. |
|
1749 t2 := text asCollectionOfLines collect:[:s | s withTabsExpanded]. |
|
1750 t1 = t2 ifTrue:[ |
|
1751 changeDelta := '=' |
|
1752 ] |
|
1753 ] |
|
1754 ] |
|
1755 ] |
|
1756 ] |
|
1757 ]. |
|
1758 entry := MultiColListEntry new. |
|
1759 entry tabulatorSpecification:tabSpec. |
|
1760 entry colAt:1 put:changeDelta. |
|
1761 entry colAt:2 put:changeString. |
|
1762 entry colAt:3 put:changeType. |
|
1763 timeStampInfo notNil ifTrue:[ |
|
1764 entry colAt:4 put:timeStampInfo. |
|
1765 ]. |
|
1766 changeHeaderLines add:entry |
|
1767 ]. |
|
1768 changeString := nil. |
|
1769 headerLine := nil. |
|
1770 |
|
1771 ] |
|
1772 ]. |
|
1773 changeString notNil ifTrue:[ |
|
1774 entry := MultiColListEntry new. |
|
1775 entry tabulatorSpecification:tabSpec. |
|
1776 entry colAt:1 put:changeDelta. |
|
1777 entry colAt:2 put:changeString. |
|
1778 entry colAt:3 put:changeType. |
|
1779 timeStampInfo notNil ifTrue:[ |
|
1780 entry colAt:4 put:timeStampInfo. |
|
1781 ]. |
|
1782 changeHeaderLines add:entry |
|
1783 ] ifFalse:[ |
|
1784 headerLine notNil ifTrue:[ |
|
1785 changeHeaderLines add:headerLine |
|
1786 ] |
|
1787 ] |
|
1788 ] |
|
1789 ] |
|
1790 ]. |
|
1791 changeClassNames := OrderedCollection new grow:(changeChunks size). |
|
1792 anyChanges := false |
|
1793 ] valueNowOrOnUnwindDo:[ |
|
1794 aStream close. |
|
1795 inBackground ifTrue:[myProcess priority:myPriority]. |
|
1796 ]. |
|
1797 ]. |
|
1798 |
|
1799 self checkIfFileHasChanged |
|
1800 |
|
1801 "Modified: / 27.8.1995 / 23:06:55 / claus" |
|
1802 "Modified: / 17.7.1998 / 11:10:07 / cg" |
|
1803 ! |
|
1804 |
|
1805 selectorOfMethodChange:changeNr |
|
1806 "return a method-changes selector, or nil if its not a methodChange" |
|
1807 |
|
1808 |source parser sel chunk aParseTree | |
|
1809 |
|
1810 source := self sourceOfMethodChange:changeNr. |
|
1811 source isNil ifTrue:[ |
|
1812 (self classNameOfChange:changeNr) notNil ifTrue:[ |
|
1813 chunk := changeChunks at:changeNr. |
|
1814 chunk isNil ifTrue:[^ nil]. "mhmh - empty" |
|
1815 aParseTree := Parser parseExpression:chunk. |
|
1816 (aParseTree isNil or:[aParseTree == #Error]) ifTrue:[ |
|
1817 ^ nil "seems strange ... (could be a comment)" |
|
1818 ]. |
|
1819 aParseTree isMessage ifFalse:[ |
|
1820 ^ nil "very strange ... (whats that ?)" |
|
1821 ]. |
|
1822 sel := aParseTree selector. |
|
1823 (#( |
|
1824 #'removeSelector:' |
|
1825 ) includes:sel) ifTrue:[ |
|
1826 sel := aParseTree arguments at:1. |
|
1827 sel isConstant ifTrue:[ |
|
1828 sel := sel evaluate. |
|
1829 sel isSymbol ifTrue:[ |
|
1830 ^ sel |
|
1831 ] |
|
1832 ] |
|
1833 ] |
|
1834 ]. |
|
1835 ^ nil |
|
1836 ]. |
|
1837 |
|
1838 |
|
1839 parser := Parser |
|
1840 parseMethodArgAndVarSpecification:source |
|
1841 in:nil |
|
1842 ignoreErrors:true |
|
1843 ignoreWarnings:true |
|
1844 parseBody:false. |
|
1845 |
|
1846 "/ parser := Parser |
|
1847 "/ parseMethod:source |
|
1848 "/ in:nil |
|
1849 "/ ignoreErrors:true |
|
1850 "/ ignoreWarnings:true. |
|
1851 |
|
1852 (parser notNil and:[parser ~~ #Error]) ifTrue:[ |
|
1853 sel := parser selector. |
|
1854 ]. |
|
1855 ^ sel |
|
1856 |
|
1857 "Created: 24.11.1995 / 14:30:46 / cg" |
|
1858 "Modified: 5.9.1996 / 17:12:50 / cg" |
|
1859 ! |
|
1860 |
|
1861 setChangeList |
|
1862 "extract type-information from changes and stuff into top selection |
|
1863 view" |
|
1864 |
|
1865 changeListView setList:changeHeaderLines expandTabs:false redraw:false. |
|
1866 changeListView invalidate. |
|
1867 |
|
1868 "/ changeListView deselect. |
|
1869 |
|
1870 "Modified: / 18.5.1998 / 14:29:10 / cg" |
|
1871 ! |
|
1872 |
|
1873 showNotFound |
|
1874 |savedCursor| |
|
1875 |
|
1876 savedCursor := cursor. |
|
1877 [ |
|
1878 self cursor:(Cursor cross). |
|
1879 self beep. |
|
1880 Delay waitForMilliseconds:300. |
|
1881 ] valueNowOrOnUnwindDo:[ |
|
1882 self cursor:savedCursor |
|
1883 ] |
|
1884 |
|
1885 "Modified: / 29.4.1999 / 22:36:54 / cg" |
|
1886 ! |
2137 ! |
1887 |
2138 |
1888 silentDeleteChange:changeNr |
2139 silentDeleteChange:changeNr |
1889 "delete a change do not update changeListView" |
2140 "delete a change do not update changeListView" |
1890 |
2141 |