axel@tub.UUCP (04/03/86)
Subject: History.st (long) Hello ! Here are the sources for the History goodie. The file should be named History.st if you want to try ChangesHistory class|example1. Have fun, axel (axel@tub.UUCP) ------------------------ cut here ------------------------ "Copyright 1986, by Axel Kramer Am Leymberg 48, 5400 Koblenz, W.Germany. (e-mail: axel@tub.UUCP). Right to use, copy, share and modify this class and its associated classes: ChangesHistoryController/View, HistoryCodeController/View, ClassChanged is granted for personal non-commercial use, provided that this copyright disclosure remains on All copies. Any other use, reproduction, or distribution requires the written consent of the author. See the category copyright/documentation in ChangesHistory class for informations concerning the usage, version, knownBugs."! "--- additional protocol for String ---"! !String methodsFor: 'converting'! withCRs "substitute all \ by CRs" ^self copyReplaceAll:'\' with: ' '.! ! "--- ok, now it really starts ---"! Object subclass: #ChangesHistory instanceVariableNames: 'stream history classes ' classVariableNames: '' poolDictionaries: '' category: 'Interface-History'! ChangesHistory comment: 'I represent the history of the changes file. I maintain 4 categories: changes in the hierarchie, changes at class level, changes on method source text and doits. The entries are stored in an OrderedCollection named history. The classes which are already definined are collected in the dictionary classes. The values are instances of ClassChanged. There are two differnet kind of entries in the history collection: 1. (category filePosition class detail) 2. (category filePosition class detail messageHeaderPosition) for method definitions (Yes I agree, these better should be classes of its own) '! !ChangesHistory methodsFor: 'initialize/release'! initialize "init the history collection and the classes dictionary." history_OrderedCollection new:100. classes_Dictionary new.! setFileStream: aStream "Set the file to the beginning and make it readOnly. Don't use the current changes file directly, one error which appears is that you can't write on it any more. (Unless you change its access rights again)" stream _ aStream. stream reset. stream readOnly! setFileStream: aStream recover: nChars "Only the last nChars of the file should be scanned. So make a copy of these chars into 'st80.recent' and work on that file. The content is copied into another file, because there are some problems if aStream is the current changes file and we're doing a snapshot. On a Macintosh this will bomb, because of the treatment of the changes file at shutDown. " aStream setToEnd; skip: nChars negated. stream _ (FileStream fileNamed: 'st80.recent') nextPutAll: (aStream next: nChars); shorten; readOnly. "start behind next end of methodFor:. This is somewhat heuristic and won't work in some cases, e.g. !!blank!! in a comment." stream upTo: $!!. [(stream upTo: $!!) size ~= 1] whileTrue: [stream upTo: $!!]! ! !ChangesHistory methodsFor: 'accessing'! classEntry: aClass "return the ClassChanged object which is associated to aClass. Create a new one if it does not yet exist." ^classes at: aClass ifAbsent: [classes at: aClass put: ClassChanged new]! classEntry: aClass ifAbsent:aBlock "return the ClassChanged object which is associated to aClass." ^classes at: aClass ifAbsent: [aBlock value]. ! classNameOf: aClassChanged "return the classname which belongs to the classChanged object." ^classes keyAtValue: aClassChanged ifAbsent:[^'']. ! classNameOfHistoryEntry: anEntry "return the classname which belongs to the entry" ^self classNameOf: (anEntry at: 3). ! detailNameOfHistoryEntry: anEntry "return the detail name." | name detail | detail _ anEntry at: 4. anEntry size = 5 ifTrue: [name _ 'defining method ', detail] ifFalse:[detail = #subclass: ifTrue:[name_'defining class'] ifFalse:[detail = #removeSelector: ifTrue:[name_'removing selector'] ifFalse:[detail = #rename: ifTrue:[name_'renaming'] ifFalse:[detail = #comment: ifTrue:[name_'comment'] ifFalse:[detail = #snapshot ifTrue:[name_'snapshot'] ifFalse:[detail = #quit ifTrue:[name_'quit'] ifFalse:[detail = #doIt ifTrue:[name_'testing'] ifFalse:[name_'new detail: ', detail asString. "missed a detail"]]]]]]]]. ^name! fileName "return the fileName of the current stream." ^stream fileName.! history ^history! sourceStringOf: indexIntoHistory "get the source text of the history content at this index. If it is a method entry, also get the header from the header position" | historyEntry header s | s_String new:100. historyEntry _ history at: indexIntoHistory ifAbsent:[^'']. self fileOutEntry: historyEntry on: (ReadWriteStream on: s). ^s! ! !ChangesHistory methodsFor: 'history entry creation'! category: category position:position class:classChanged detail:detail "create an history entry" ^Array with:category with:position with:classChanged with:detail! category: category position:position class:classChanged selector:selector header:headerPosition "create an history entry of a method definition." ^Array with:category with:position with:classChanged with:selector with:headerPosition! simpleDoItAt:position "Create simple doIt history entry" ^Array with:4 with:position with:nil with: #doIt! simpleDoItAt:position class: classChanged "Create simple doIt history entry with known class" ^Array with:4 with:position with: classChanged with: #doIt! simpleDoItAt:position detail: detail "Create simple doIt history entry with given detail." ^Array with:4 with:position with: nil with: detail! ! !ChangesHistory methodsFor: 'scanning'! scanChanges "Scan the stream for expressions from text that has been formatted with exclamation delimitors. The expressions are read, selected for the apropriate category and added to the history list, which is returned." | | Cursor read showWhile: [[stream skipSeparators. stream atEnd] whileFalse: [(stream peekFor: $!!) ifTrue: [Cursor marker showWhile: [ history addAll: self scanMethodsFor]] ifFalse: [Cursor square showWhile: [ history addLast: self scanDoIt]]]. ]. ^history! scanDoIt "Read the expression and put it in one of the categories. Return the category index and the file position." | s p tokenList aClass | p _ stream position. tokenList _ Scanner new scanTokens: stream nextChunk. tokenList size >= 3 ifTrue: [aClass_tokenList at:1. (tokenList at: 2) = #removeSelector: ifTrue: [ (self classEntry:aClass) removeSelector:(tokenList at:3). ^self category: 2 position: p class: (self classEntry: aClass) detail: #removeSelector]. (tokenList at: 2) = #comment: ifTrue: [^self category: 2 position: p class: (self classEntry: aClass) detail: #comment:]. (tokenList at: 2) = #rename: ifTrue: [ classes at: (tokenList at:3) put: (self classEntry:aClass). ^self category: 1 position: p class: (self classEntry: aClass) detail: #rename]. (tokenList at: 3) = #removeSelector: ifTrue: [ (self classEntry:aClass) removeMetaSelector:(tokenList at:4). ^self category: 2 position: p class: (self classEntry: aClass) detail: #removeSelector:]. (tokenList at: 3) = #instanceVariableNames: ifTrue: [ ^self category: 2 position: p class: (self classEntry: aClass) detail: #subclass:]. (tokenList at: 2) = #subclass: ifTrue: [^self category: (self changedClass: (tokenList at: 3) category: tokenList last superclass: tokenList first) position: p class: (self classEntry: (tokenList at: 3)) detail: #subclass:]. (tokenList at: 2) = #variableSubclass: ifTrue: [^self category: (self changedClass: (tokenList at: 3) category: tokenList last superclass: tokenList first) position: p class: (self classEntry: (tokenList at: 3)) detail: #subclass:]. ^self scanSimpleDoItAt: p tokenList:tokenList] ifFalse: [^self scanSimpleDoItAt: p tokenList:tokenList]! scanMethodsFor "Scan the methodFor: message. Return an ordered collection of category indeces and file positions. If the method definition is really new return category 2, else return category 3. The file position for all methods for one category is that of the header methodFor:. If there is more then one method in one category definition it is almost a fileIn of a file and will be treated as category 2." | s p tokenList class meta historyList selector headerPosition | historyList_OrderedCollection new. headerPosition_stream position. "get the class out of it" tokenList _ Scanner new scanTokens: stream nextChunk. class _ tokenList first. tokenList size = 4 ifTrue:[meta_true] ifFalse:[meta_false]. "now to the methods itself" [p _ stream position. s _ stream nextChunk. s size > 0 "done when double terminators"] whileTrue: [ selector _ Parser new parseSelector: s. historyList add: (self category:(self changedMethod: selector class:class meta:meta) position:p class:(self classEntry:class) selector:selector header:headerPosition). ]. ^historyList.! scanSimpleDoItAt: position tokenList: tokenList "Before giving up try some obvious tests to classify the DoIt. If it is a string compare to 'snapshot' and 'quit' and make detail either #snapshot or #quit. If the first token is in classes link the entry to that class." | aClassChanged first | tokenList size = 0 ifTrue: [^self simpleDoItAt: position]. first _ tokenList first. first class == String ifTrue: [ first = '----SNAPSHOT----' ifTrue: [ ^self simpleDoItAt: position detail: #snapshot]. first = '----QUIT----' ifTrue: [ ^self simpleDoItAt: position detail: #quit]] ifFalse: [first class == Symbol ifTrue: [ aClassChanged _ classes at: first ifAbsent: [^self simpleDoItAt: position]. ^self simpleDoItAt: position class: aClassChanged]]. ^self simpleDoItAt: position! ! !ChangesHistory methodsFor: 'select categories'! changedClass: aClass category: aString superclass: aSuperclass "Is this class new or does its superclass or category changed; then put it into category 1 for changes of the class hierarchy. In all other cases its just a change of the class description, which means category 2." | c | c _ classes at: aClass ifAbsent: [classes at: aClass put: (ClassChanged category: aString superclass: aSuperclass). ^1]. (c changedCategory: aString superclass: aSuperclass) ifTrue: [^1] ifFalse: [^2]! changedMethod: selector class: class meta: meta "look in classes, if the selector is already defined and return category 3 if true, else category 2." | c | c _ classes at: class ifAbsent: [classes at: class put: (meta ifTrue: [ClassChanged metaSelector: selector] ifFalse: [ClassChanged selector: selector]). ^2]. meta ifTrue: [(c includesMetaSelector: selector) ifTrue: [^3]] ifFalse: [(c includesSelector: selector) ifTrue: [^3]]. ^2! ! !ChangesHistory methodsFor: 'fileIn/Out'! fileInEntry: entry "fileIn the history entry." 5 = entry size ifTrue: ["this is a methode entry" (Compiler evaluate: (stream position: (entry at: 5)) nextChunk logged: false) scanFrom: (stream position: (entry at: 2))] ifFalse: [[Compiler evaluate: (stream position: (entry at: 2)) nextChunk logged: true]].! fileInEntryAt: entryIndex "fileIn the entry at index in history." self fileInEntry: (history at:entryIndex ifAbsent:[^self]).! fileOutEntry: entry on: aFileStream "fileOut the history entry. If it is a method entry don't forget the header." 5 = entry size ifTrue: ["this is a methode entry" aFileStream nextPut: $!!; copyChunkFrom: (stream position: (entry at: 5)); cr; copyChunkFrom: (stream position: (entry at: 2)); nextPutAll: ' !!'] ifFalse: [ aFileStream copyChunkFrom: (stream position: (entry at: 2))]. ! fileOutEntryAt: entryIndex on:aStream "fileOut the entry at index in history." self fileOutEntry: (history at:entryIndex ifAbsent:[^self]) on:aStream.! ! !ChangesHistory methodsFor: 'create view'! createView "comment stating purpose of message" ChangesHistoryView open:self.! ! "-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "! ChangesHistory class instanceVariableNames: ''! !ChangesHistory class methodsFor: 'copyright/documentation'! copyright "Copyright 1986 by Axel Kramer, Am Leymberg 48, 5400 Koblenz, W.Germany. (e-mail: axel@tub.UUCP). Right to use, copy, share and modify this class and its associated classes: ChangesHistoryController/View, HistoryCodeController/View, ClassChanged is granted for personal non-commercial use, provided that this copyright disclosure remains on All copies. Any other use, reproduction, or distribution requires the written consent of the author." ^'Copyright (c) April, 1986 by Axel Kramer'! howToUseIt " A ChangesHistoryView is opened by several messages to the ChangesHistory class.(See ChangesHistory|instance creation/examples). It is possible to open the view on an arbitrary file, or to recover i-characters from the current changes file. The view consists of 2 panes, in the upper pane you will see a visual representation of the history, namely horizontal bars in four categories, and in the lower pane you will see source text, if an entry in the upper pane is selected. The leftmost category in the upper pane represents actions which have implications on the class hierarchy, e.g. the first definition of a class, changes in the subclass relationship and renaming of classes will appear here. The second category shows actions which result in the change of a class description, e.g. adding/removing protocol and variables, comments of a class. The third category represents changes in the source text of methods. The first definition of a method goes in the second category (protocol change), all further definitions will go in the third category. All the rest of expressions and actions appear in the fourth category, e.g. doIt's from testing, snapshot and quit messages. The first time the view comes up, all entries appear in black, they are emphasized and may be selected by pointing and clicking with the mouse. A selection results in a change of the second pane, which always displays the source text of the selection (OK. don' bother a selection is currently not highlighted). If the entries seem to small for you to be properly selected, use the bigger/smaller command of the pop up menu of this pane. The searchUp and searchDown command let you search for the next emphasized entry, which will be selected and its source text displayed. The two buttons at the bottom of the upper pane let you choose restrict the emphasized entries to those of the same class (class button) or of the same detail (detail button), or both. Associated with each entry is its detail name: #subclass: --> class definitions #rename: --> class renaming #removeSelector: --> removing methods from a class method selector --> different for each method definition #snapshot --> snapshot (at category four) #quit --> quit (also at category four) #DoIt --> all other expressions All entries are associated to the class they belong to, except most of the doIt's in category four. Only in obvious cases, when the receiver is in the set of previously used classes, the doIts get their class link as well. If you make a selection and then choose one of the two buttons all entries which are not equal to the selection, in the sense of the class/detail relationship, are deemphasized. You may not select deemphasized entries unless you press the shift key while clicking the mouse. The searchEntry command in the pum gives you a template for searching entries from the beginning of the file. It will select and scroll to the entry, or will flash the view. All emphasized entries, or those of certain categories may be transferred to the edit pane. Use the editEmphasized, hierarchy level, class level, and method level command in the pum for this purpose. (The transfer happens via a temporary file, so don't get upset when the disk starts running here). The transferred entries in the edit pane are headed by a string which describes the entries. You may perform the Smalltalk-traditional editing command in the editPane, even it won't have any implications on the source. The command fileItIn of the editPane pum will fileIn the current selection. The command fileIn will fileIn the entire content of the editPane. The command fileOut will ask you for a filename and will fileOut the entire content of the edit pane." ^self! knownBugs " 1. don't use the current changes file directly!! (ChangesHistory changesRecover:nChars is ok) 2. cursorLine in upperPane is blinking if one line above top. 3. blue button menu in the view will come only if you move the mouse while pressing the enter key and mouse button. Magic, refer to ChangesHistoryController|blueButtonActivity. 4. scrolling in the upperPane is not optimized. "! purpose "These classes were written to visualize and examine the history of a changes file; which is related to my ongoing research in the dynamics of an object-oriented software development. The ChangesHistoryView also assist in accessing arbitrary files with Smalltalk-like formatted sources in a structured way. In some respect it provides a similar functionality as the ChangeManagement Browser which comes with Version 2 of Smalltalk 80. " ^self! readMe ">This piece is dedicated to Barbara, who was far away that week<" "I would appreciate getting some response about things you liked, disliked, changed, and suggested improvements. My e-mail address is: UUCP: axel@tub.UUCP BITNET: axel@DB0TUI6.BITNET (the 0 is a zero) Have fun axel PS: I am sorry for the non-Mac Smalltalk users. The easiest way to get ChangesHistory running out there is to simulate Mac moveTo:v:, lineTo:v:, penMode:, penNormal, with a Pen class. Or use bitBlt, the lines are always horizontal. I guess, you should also throw out the file-exists piece. " ^self! version "The current version was developed using Apple's Smalltalk Version 1 on my 'old' Mac with 1MB RAM and a 20MB Hyperdrive, within the last week of March, 1986." ^'version 1.0'! ! !ChangesHistory class methodsFor: 'examples'! example1 "Scan and view the file History.st. Display the time for scanning on the SystemTranscript. The time for my 'old' Mac with 1MB Ram and a 20MB Hyperdrive is around: 2 minutes (330-402 bytes per second). I would appreciate if you could mail me the time needed on other machines or configurations. (e-mail: axel@tub.UUCP)." "ChangesHistory example1" ChangesHistory timedOfFileNamed: 'History.st'! example2 "Recover last 5000 chars of the current changes file." "ChangesHistory example2" ChangesHistory changesRecover:5000! ! !ChangesHistory class methodsFor: 'instance creation'! changesRecover: nCharacters "evaluate last nCharacters of the changes file. scan the file and open a ChangesHistoryView. " | f h | f _ FileStream oldFileNamed: (SourceFiles at: 2) fileName. h _ ChangesHistory ofFileStream: f recover: nCharacters. h scanChanges. h createView! ofFileNamed: aString "evaluate the file named aString. scan the file and open a ChangesHistoryView. " | f h | f _ FileStream oldFileNamed: aString. h _ ChangesHistory ofFileStream: f. h scanChanges. h createView! ofFileStream: aStream "this stream will be evaluated" | h | h_self new. h setFileStream: aStream. ^h.! ofFileStream: aStream recover: nCharacters "this stream will be evaluated, starting nCharacters from the end." | h | h_self new. h setFileStream: aStream recover: nCharacters. ^h.! timedOfFileNamed: aString "evaluate the file named aString. scan the file and open a ChangesHistoryView. " | f h t m | f _ FileStream oldFileNamed: aString. h _ ChangesHistory ofFileStream: f. t _ (Time millisecondsToRun: [h scanChanges]) / 1000. Transcript show: (m _ (t / 60) asInteger) printString , ':' , (t - (m * 60)) asFloat printString , ' min (' , (f size / t) asInteger printString , ' bytes per second)'; cr. h createView! ! !ChangesHistory class methodsFor: 'privat'! new ^super new initialize! ! ScrollController subclass: #ChangesHistoryController instanceVariableNames: '' classVariableNames: 'HistoryYellowButtonMessages HistoryYellowButtonMenu ' poolDictionaries: '' category: 'Interface-History'! ChangesHistoryController comment: 'Control the view. Responsible for providing scroll informations and displaying the cursorLine, selecting entries. There is a small error in here, look at blueButtonActivity.'! !ChangesHistoryController methodsFor: 'initialize'! initializeYellowButtonMenu self yellowButtonMenu: HistoryYellowButtonMenu yellowButtonMessages: HistoryYellowButtonMessages! ! !ChangesHistoryController methodsFor: 'marker adjustment'! computeMarkerRegion "Refer to the comment in ScrollController|computeMarkerRegion." ^0@0 extent: 10 @ ((scrollBar inside height asFloat / (view toYValue:model history size+4) * scrollBar inside height) rounded min: scrollBar inside height) ! updateMarker "This is called by biggerEntry and smallerEntry of the view to change the scrollbar according to a new entry height and gap" | newMarkerRegion | newMarkerRegion _ self computeMarkerRegion. newMarkerRegion ~= marker region ifTrue: [self markerRegion: newMarkerRegion. self moveMarker. marker height >= scrollBar inside height ifTrue:[ "scrollContent to beginning" view scrollBy: 0@ self viewDelta]] ! ! !ChangesHistoryController methodsFor: 'scrolling'! scrollAmount "Refer to the comment in ScrollController|scrollAmount." ^view toEntry: sensor cursorPoint y - scrollBar inside top! ! !ChangesHistoryController methodsFor: 'cursorLine'! xorLineCursorAt:yGrid displayBox: displayBox "xor the line at full insetDisplayBox width." Mac penMode: 10. "xor" Mac penSize: 1 height: view entryHeight + (2* view entryGap). Mac moveTo: displayBox left v: yGrid; lineTo: displayBox right v: yGrid. Mac penNormal. ! ! !ChangesHistoryController methodsFor: 'control defaults'! blueButtonActivity "A Dummy to erase the cursorLine in time. Here is an error: the system pum will only appear if you move the cursor while pressing the enter key and the mouse button. That's a bit magic to me, should I redefine viewHasCursor, or what is the problem?" | y displayBox s | displayBox _ view insetDisplayBox. (displayBox containsPoint: (s _ sensor cursorPoint)+view entryGap) "that's heuristic :-) " ifTrue: [y _ (view toGrid: s y - displayBox top) + displayBox top. self xorLineCursorAt:y displayBox: displayBox. super blueButtonActivity. self xorLineCursorAt: y displayBox: displayBox] ifFalse:[super blueButtonActivity].! controlActivity "Refer to the comment in Controller|controlActivity." | displayBox y s | displayBox _ view insetDisplayBox. (displayBox containsPoint: (s _ sensor cursorPoint)+view entryGap) "that's heuristic :-) " ifTrue: [y _ (view toGrid: s y - displayBox top) + displayBox top. self xorLineCursorAt:y displayBox: displayBox. [((view toGrid: (s _ sensor cursorPoint) y - displayBox top) + displayBox top) = y and:[displayBox containsPoint:s]] whileTrue:[super controlActivity]. self xorLineCursorAt: y displayBox: displayBox.] ifFalse: [super controlActivity]! isControlActive ^super isControlActive & sensor blueButtonPressed not! redButtonActivity "calculate the current selection, set it and broadcast a change. A new selection is only allowed, if it fits into the currently selected things (it is displayed in black), or the shift key is pressed during the selection." | displayBox y offset oldSelection shiftDown | displayBox _ view insetDisplayBox. y _ sensor cursorPoint y. shiftDown _ sensor leftShiftDown. offset _ (view toEntry: y - displayBox top) + (view window top truncated max: 1). oldSelection _ view selection. (view equalEmphasizeOf: offset and: view selection) | shiftDown ifTrue: [Cursor read showWhile:[ view selection: offset. view changed. "Now test if it is necessary to redisplay the view, caused of a changed selection." (view equalEmphasizeOf: oldSelection and: view selection) ifFalse: [y _ (view toGrid:y- displayBox top) + displayBox top. self xorLineCursorAt: y displayBox: displayBox. view displayView. self xorLineCursorAt: y displayBox: displayBox]]]! yellowButtonActivity "A Dummy to erase the cursorLine in time." | y displayBox s | displayBox _ view insetDisplayBox. (displayBox containsPoint: (s _ sensor cursorPoint)+view entryGap) "that's heuristic :-) " ifTrue: [y _ (view toGrid: s y - displayBox top) + displayBox top. self xorLineCursorAt:y displayBox: displayBox. super yellowButtonActivity. self xorLineCursorAt: y displayBox: displayBox] ifFalse:[super yellowButtonActivity].! ! !ChangesHistoryController methodsFor: 'menu defaults'! menuMessageReceiver ^view! ! "-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "! ChangesHistoryController class instanceVariableNames: ''! !ChangesHistoryController class methodsFor: 'class initialization'! initialize "init the pum" HistoryYellowButtonMenu _ PopUpMenu labels: 'bigger\smaller searchUp\searchDown\searchEntry edit emphasized entries\hierarchy level\class level\method level' withCRs lines: #(2 5). HistoryYellowButtonMessages _ #(biggerEntry smallerEntry searchUp searchDown searchEntry fileOutEmphasized fileOutHierarchyLevel fileOutClassLevel fileOutMethodLevel) "ChangesHistoryController initialize"! ! !ChangesHistoryController class methodsFor: 'instance creation'! new ^super new initializeYellowButtonMenu! ! ChangesHistoryController initialize! View subclass: #ChangesHistoryView instanceVariableNames: 'emphasizeBlock selection classSwitch detailSwitch entryHeight entryGap tempFile lastSearchString ' classVariableNames: '' poolDictionaries: '' category: 'Interface-History'! ChangesHistoryView comment: 'My instances display the upper pane, in which the categories are drawn.'! !ChangesHistoryView methodsFor: 'initialisation'! initialize "Set the switches to false." super initialize. classSwitch _ detailSwitch _ false. selection _ -1. entryHeight _ 1. entryGap _ 1. self emphasizeAll.! release "delete the temp file if it is out there" super release. (tempFile notNil and:[ tempFile exists]) ifTrue:[tempFile delete].! ! !ChangesHistoryView methodsFor: 'accessing'! contents "this is only necessary for the HistoryCodeView initialisation. Just return an empty String." ^''! emphasizeBlock: aBlock "This block is evaluated while displaying the view. It gets one parameter: the element which will be displayed next. If the block returns true it will be displayed with a black pen, else with a gray pen." emphasizeBlock _ aBlock! entryGap "The number of pixels between to entries." ^entryGap! entryHeight "The height of an entry in pixels." ^entryHeight! fileOutFile "return tempFile" ^tempFile! lastSearchString "return the searchString, if it is nil initialize it." lastSearchString isNil ifTrue:[lastSearchString _ 'searchClass: #any\ detail: #any' withCRs]. ^lastSearchString! selection ^selection! selection: indexIntoHistory selection _ indexIntoHistory! toEntry: yValue "Transform y value to element according to entryGap and entryHeight" ^(yValue / (entryGap + entryHeight)) truncated! toGrid: yValue "Transform y value to a gridded y value, according to entryGap and entryHeight" | d | ^(d_entryGap+entryHeight) * (yValue / d) truncated! toYValue: entryIndex "Transform to YValue according to entryGap and entryHeight" ^(entryIndex * (entryGap + entryHeight)) asInteger! ! !ChangesHistoryView methodsFor: 'emphasize access'! emphasizeAll "There should be no entry in gray, all in black" emphasizeBlock _ [:e :f |true].! emphasizeClassAlikes "Emphasize entries which have the same class as the selection (The selection value is one of the parameters). The offset for the classChanged object in history entries is 3." emphasizeBlock _ [:e :f | (f at: 3) == (e at: 3)]! emphasizeClassAndDetailAlikes "Emphasize entries which have the same class and the same detail as the selection. " emphasizeBlock _ [:e :f | (f at: 3) == (e at: 3) and: [(f at: 4) == (e at: 4)]]! emphasizeDetailAlikes "Emphasize entries which have the same detail as the selection. The offset for details in history entries is 4." emphasizeBlock _ [:e :f | (f at: 4) == (e at: 4)]! ! !ChangesHistoryView methodsFor: 'emphasize testing'! equalEmphasizeOf: firstIndex and: secondIndex "Compare the two entries in the history which are denoted by the firstIndex and secondIndex. This is used from the Controller to test if redisplaying is necessary if the selection changed" ^emphasizeBlock value: (model history at: firstIndex ifAbsent: [^true]) value: (model history at: secondIndex ifAbsent: [^true])! ! !ChangesHistoryView methodsFor: 'switches messages'! classSwitch "return the value. Used by the switch controller" ^classSwitch! detailSwitch "return the value. Used by the switch controller" ^detailSwitch! evaluateSwitches "evaluate the classSwitch and detailSwitch to set the emphasizeBlock accordingly." classSwitch & detailSwitch ifTrue:[self emphasizeClassAndDetailAlikes] ifFalse:[classSwitch ifTrue:[self emphasizeClassAlikes] ifFalse:[detailSwitch ifTrue:[self emphasizeDetailAlikes] ifFalse:[self emphasizeAll]]]. ! toggleClassSwitch "toggle classSwitch and evaluateSwitches" classSwitch ifTrue:[classSwitch _ false] ifFalse:[classSwitch _ true]. self evaluateSwitches. self displayView. self changed.! toggleDetailSwitch "toggle detailSwitch and evaluateSwitches" detailSwitch ifTrue:[detailSwitch _ false] ifFalse:[detailSwitch _ true]. self evaluateSwitches. self displayView. self changed.! ! !ChangesHistoryView methodsFor: 'menu messages'! biggerEntry "increment the entryHeight" entryHeight _ entryHeight+entryGap. entryGap _ entryHeight//2 max:1. controller updateMarker. self clearInside; displayView. ! searchClass: aClass detail: aDetail "Search the history for the class and the detail and return the firstIndex found (from the top). If aClass or aDetail is equal to #any don't use them for searching, if they are both #any just return 0. This will change the settings of detailSwitch and classSwitch. Return 0 if entry not found." | aClassChanged myEntry oldDetailSwitch oldClassSwitch toScroll | aDetail = #any & (aClass = #any) ifTrue: [^0]. oldDetailSwitch _ detailSwitch. oldClassSwitch _ classSwitch. aClass = #any ifTrue: ["test this first, because it may return if class not in classes" classSwitch _ false. aClassChanged _ nil] ifFalse: [aClassChanged _ model classEntry: aClass ifAbsent: [self flash. ^0]. classSwitch _ true]. aDetail = #any ifTrue: [detailSwitch _ false] ifFalse: [detailSwitch _ true]. self evaluateSwitches. myEntry _ model category: 0 position: 0 class: aClassChanged detail: aDetail. 1 to: model history size do: [:i | (emphasizeBlock value: (model history at: i) value: myEntry) ifTrue: [^i]]. self flash. detailSwitch _ oldDetailSwitch. classSwitch _ oldClassSwitch. self evaluateSwitches. "restore emphasizeBlock" ^0! searchDown "search from selection upward to next emphasized entry and bring it in the middle of the view." | selectionInHistory toScroll | selectionInHistory _ model history at: selection ifAbsent:[^self]. selection+1 to: model history size do:[:i| (emphasizeBlock value: (model history at:i) value:selectionInHistory) ifTrue:[^self displayInCenter: i]]. self flash. ! searchEntry "The user may specify a class and/or a detail which is searched for, starting at the beginning of the history." | toEvaluate newSearchString index | FillInTheBlank request: 'Fill in search template.\To abort just hit CR' withCRs displayAt: Sensor cursorPoint centered: true action: [:answer | newSearchString _ answer] initialAnswer: self lastSearchString. lastSearchString = newSearchString ifTrue:[^self]. lastSearchString _ nil. "if the compiler will not return (because of a syntax error, etc.) reinitialize the searchString next time" controller controlTerminate. index_ Compiler evaluate: 'self ', newSearchString for:self logged:false. controller controlInitialize. index = 0 ifFalse:[self displayInCenter:index]. lastSearchString _ newSearchString. ! searchUp "search from selection downward to next emphasized entry and bring it in the middle of the view." | selectionInHistory toScroll | selectionInHistory _ model history at: selection ifAbsent:[^self]. selection-1 to: 1 by:-1 do:[:i| (emphasizeBlock value: (model history at:i) value:selectionInHistory) ifTrue:[^self displayInCenter: i]]. self flash. ! smallerEntry "decrement the entryHeight" entryHeight _ entryHeight-1 max:1. entryGap _ entryHeight//2 max:0. controller updateMarker. "must come first, may scroll view!!" self clearInside; displayView. ! ! !ChangesHistoryView methodsFor: 'fileIn/Out'! createTempFile "create the temp file" tempFile _ FileStream fileNamed: self tempFileName. ! fileHeaderWithPrefix: aString "make a comment out of the selection and the current settings for emphasing. This comment will be used as the header of the fileOut file. " | selectionInHistory comment noSelection className detail | "empty selection:" noSelection _ false. selectionInHistory _ model history at:selection ifAbsent:[noSelection _ true]. noSelection ifTrue:[comment _ 'all entries'] ifFalse:[ className_self model classNameOfHistoryEntry:selectionInHistory. detail_self model detailNameOfHistoryEntry: selectionInHistory. classSwitch & detailSwitch ifTrue:[comment_className, ' ', detail] ifFalse:[ classSwitch ifTrue:[className isEmpty ifTrue:[comment_detail] ifFalse:[comment_'class ', className]] ifFalse:[ detailSwitch ifTrue:[comment_detail] ifFalse:[ comment_'all entries']]]]. ^'''', aString, comment, ' (file: ', model fileName, ' ', Time dateAndTimeNow printString, ')''!!'. ! fileOutCategoryBlock:aBlock prefix: commentPrefix "file out emphasized entries for which the block returns true. The block should expect one argument, a history entry." | entry none | (classSwitch | detailSwitch) not & (model history size > 200) ifTrue:[ (((PopUpMenu labels:'proceed\abort' withCRs) startUpWithCaption:'The file will become big!!') =1) ifFalse:[^self]]. self openTempFile. tempFile nextPutAll: (self fileHeaderWithPrefix:commentPrefix); cr. none_true. Cursor execute showWhile:[ 1 to: model history size do:[:i| entry _ model history at:i. ((aBlock value:entry) and:[self equalEmphasizeOf:i and: selection]) ifTrue:[Cursor write showWhile:[ none ifFalse:[tempFile cr; cr] ifTrue:[none_false]. model fileOutEntry: entry on:tempFile]]]. tempFile close]. none ifTrue:[self flash. "the file will be overwritten next time"] ifFalse:[ self changed:#fileOut].! fileOutClassLevel "try the last sentence of the fileOutMethodLevel comment. File out all subclass definitions (even those in category 1) and all other stuff in category 2." self fileOutCategoryBlock:[:e|((e at: 4) =#subclass:) | ((e at:1) = 2)] prefix:'Class level: '. ! fileOutEmphasized "File out emphasized entries. Give a warning if emphasizeAll is on and more then 200 entries are emphasized (Anyway this will only copy the changes file entirely which will be faster with the finder. If there is no selection at all just return." classSwitch | detailSwitch & (selection = -1) ifTrue: [^self]. self fileOutCategoryBlock: [:e | true] prefix: 'All categories: '! fileOutHierarchyLevel self fileOutCategoryBlock:[:e| (e at:1) = 1] prefix:'Hierarchy level: '. ! fileOutMethodLevel "File out all method definitions (even at category 2). I agree, there are some things here which I should better get from ChangesHistory." self fileOutCategoryBlock: [:e | e size = 5 | ((e at: 1) = 3)] prefix: 'Method level: '! openTempFile "open the temp file. First test if it exists (e.g. on going back to an older image, or first time moving something to the edit area)." (tempFile isNil or: [tempFile exists not]) ifTrue: [self createTempFile]. tempFile open; reset; writeShorten! tempFileName ^(Time now printString copyReplaceAll:':' with:'-'), '.tempHistory'. ! ! !ChangesHistoryView methodsFor: 'displaying'! displayInCenter: entryIndex "Select the entry and scroll the view, so that the entry at entryIndex comes in the middle of the view." | toScroll | self selection: entryIndex. "important to do that first!!" toScroll _ (self toEntry: self insetDisplayBox height / 2) + self window top truncated - entryIndex. controller scrollView: toScroll. controller updateMarker. self changed! displayView "display the content of the history" | numberOfElements widthElement offsetX offsetY category gap xLeft xRight y startIndex stopIndex history selectionInHistory | history _ model history. selectionInHistory _ history at: selection ifAbsent:[#(nil nil nil nil nil)]. numberOfElements_ self toEntry:self insetDisplayBox height. widthElement_(self insetDisplayBox width/4)truncated. gap _ 4. offsetX_ self insetDisplayBox topLeft x. offsetY _ self insetDisplayBox topLeft y. startIndex_self window top truncated max: 1. stopIndex_startIndex - 1 + numberOfElements min: history size. y _ offsetY + entryGap. Mac penSize:1 height: entryHeight. startIndex to: stopIndex do:[:i| category_(history at: i) first - 1. xLeft _ category * widthElement + offsetX + gap. xRight _ xLeft + widthElement - gap - gap. (emphasizeBlock value: (history at:i) value:selectionInHistory) ifTrue:[Mac penPat: Mac black] ifFalse:[Mac penPat: Mac ltGray]. Mac moveTo:xLeft v:y; lineTo:xRight v:y. y _ y + entryHeight + entryGap. ]. Mac penPat: Mac black.! flash "flash to inform the user that an operation finished without success (e.g. search: entry not found, ...)" 4 timesRepeat:[super flash]! ! !ChangesHistoryView methodsFor: 'display box access'! boundingBox "return the box which is used for scaling the marker. history size + 1 is used to avoid division by zero errors in empty files." ^0 @ 0 extent: self insetDisplayBox width @ (model history size + 1)! ! !ChangesHistoryView methodsFor: 'privat'! doItContext "for the HistoryCodeView." ^nil! doItReceiver "for the HistoryCodeView." ^nil! ! "-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "! ChangesHistoryView class instanceVariableNames: ''! !ChangesHistoryView class methodsFor: 'view creation'! open: aChangesHistory "create a ChangesHistoryView embedded in a StandardSystem view" | topView aCodeView aHistoryView classSwitchView detailSwitchView | topView _ StandardSystemView new. topView label: 'Changes History of ', aChangesHistory fileName. aHistoryView _ self buildChangesHistoryViewOn: aChangesHistory. aCodeView _ HistoryCodeView new model: aHistoryView. aCodeView window: (0 @ 0 extent: 100 @ 30). aCodeView borderWidthLeft: 2 right: 2 top: 0 bottom: 2. classSwitchView _ self buildClassSwitchOn: aHistoryView. detailSwitchView _ self buildDetailSwitchOn:aHistoryView. topView addSubView: aHistoryView. topView addSubView: aCodeView. topView addSubView: classSwitchView. topView addSubView: detailSwitchView. classSwitchView align: classSwitchView viewport topLeft with: aHistoryView viewport bottomLeft. detailSwitchView align: detailSwitchView viewport topLeft with:classSwitchView viewport topRight. aCodeView align: aCodeView viewport topLeft with: classSwitchView viewport bottomLeft. topView controller open! ! !ChangesHistoryView class methodsFor: 'privat'! buildChangesHistoryViewOn: aChangesHistory | aDataView | aDataView _ ChangesHistoryView new model: aChangesHistory. aDataView controller: ChangesHistoryController new. aDataView window: (0 @ 0 extent: 100 @ 70). aDataView borderWidth:2. aDataView insideColor:Form white. ^aDataView ! buildClassSwitchOn: aChangesHistoryView "Build the switchView which represents the classSwitch." | aSwitchView | aSwitchView _ SwitchView new. aSwitchView model: aChangesHistoryView. aSwitchView selector: #classSwitch. aSwitchView controller selector: #toggleClassSwitch. aSwitchView window: (0 @ 0 extent: 50 @ 7). aSwitchView borderWidthLeft: 2 right: 2 top: 0 bottom: 2. aSwitchView label: 'class' asParagraph. ^aSwitchView! buildDetailSwitchOn: aChangesHistoryView "Build the switchView which represents the detailSwitch." | aSwitchView | aSwitchView _ SwitchView new. aSwitchView model: aChangesHistoryView. aSwitchView selector: #detailSwitch. aSwitchView controller selector: #toggleDetailSwitch. aSwitchView window: (0 @ 0 extent: 50 @ 7). aSwitchView borderWidthLeft: 0 right: 2 top: 0 bottom: 2. aSwitchView label: 'detail' asParagraph. ^aSwitchView! ! Object subclass: #ClassChanged instanceVariableNames: 'category superclass selectors metaSelectors ' classVariableNames: '' poolDictionaries: '' category: 'Interface-History'! ClassChanged comment: 'I represent data related to a class which is used in the changesHistory. In detail this is the category and the superclass of a class, as well as two sets of message selectors, one for the class and one for its meta class. Implementation hint: the sets are nil if they are empty and should be accessed only through the two set related messages of the testing protocol.'! !ClassChanged methodsFor: 'accessing'! category: c category _ c.! category: aCategory superclass: aSuperclass category _ aCategory. superclass _ aSuperclass.! superclass: c superclass _ c.! ! !ClassChanged methodsFor: 'testing'! changedCategory: aCategory superclass: aSuperclass "return true if there is a change in the category or superclass and replace the old value." | changed | changed _ false. category = aCategory ifFalse: [category _ aCategory. changed _ true]. superclass = aSuperclass ifFalse: [superclass _ aSuperclass. changed _ true]. ^changed! includesMetaSelector: aSelector "return true if the selector is already in set metaSelectors. If not, add it to the set and return false." metaSelectors isNil ifTrue: [metaSelectors _ Set with: aSelector. ^false] ifFalse: [(metaSelectors includes: aSelector) ifTrue: [^true] ifFalse: [metaSelectors add: aSelector. ^false]]! includesSelector: aSelector "return true if the selector is already in set selectors. If not, add it to the set and return false." selectors isNil ifTrue: [selectors _ Set with: aSelector. ^false] ifFalse: [(selectors includes: aSelector) ifTrue: [^true] ifFalse: [selectors add: aSelector. ^false]]! removeMetaSelector: aSelector "remove the selector from metaSelectors, don't bother if it isn't in there." metaSelectors isNil ifFalse: [metaSelectors remove: aSelector ifAbsent:[]]! removeSelector: aSelector "remove the selector from selectors, don't bother if it isn't in there." selectors isNil ifFalse: [selectors remove: aSelector ifAbsent:[]]! ! "-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "! ClassChanged class instanceVariableNames: ''! !ClassChanged class methodsFor: 'instance creation'! category: aCategory superclass: aSuperclass "create a new instance and init the category and superclass variable." | d | d_self new. d category: aCategory superclass: aSuperclass. ^d. ! metaSelector: aSelector "create a new instance and init the metaSelectors set with aSelector." | d | d_self new. d includesMetaSelector:aSelector. ^d. ! selector: aSelector "create a new instance and init the selectors set with aSelector." | d | d_self new. d includesSelector:aSelector. ^d. ! ! StringHolderController subclass: #HistoryCodeController instanceVariableNames: '' classVariableNames: 'HistoryYellowButtonMessages HistoryYellowButtonMenu ' poolDictionaries: '' category: 'Interface-History'! HistoryCodeController comment: 'I am controlling the lower pane and doing the FileIn/Out stuff'! !HistoryCodeController methodsFor: 'menu messages'! fileIn "ask the view to fileIn either the last fileOut file or the current entry" self controlTerminate. view fileIn. self controlInitialize! fileItIn "Make a Stream on the text selection and fileIn it." | aStream selection | self controlTerminate. selection _ self selection. (ReadWriteStream on: selection string from: 1 to: selection size) fileIn. self controlInitialize! fileOut "ask the view to fileOut either the last fileOut file or the current entry" self controlTerminate. view fileOut. self controlInitialize! ! !HistoryCodeController methodsFor: 'privat'! initializeYellowButtonMenu self yellowButtonMenu: HistoryYellowButtonMenu yellowButtonMessages: HistoryYellowButtonMessages! ! "-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "! HistoryCodeController class instanceVariableNames: ''! !HistoryCodeController class methodsFor: 'class initialization'! initialize "Initialize the yellow button pop-up menu and corresponding messages." HistoryYellowButtonMenu _ PopUpMenu labels: 'again\undo copy\cut\paste doIt\printIt\fileItIn fileIn\fileOut\cancel' withCRs lines: #(2 5 8 10). HistoryYellowButtonMessages _ #(again undo copySelection cut paste doIt printIt fileItIn fileIn fileOut cancel ) "HistoryCodeController initialize"! ! HistoryCodeController initialize! StringHolderView subclass: #HistoryCodeView instanceVariableNames: 'currentSelection ' classVariableNames: '' poolDictionaries: '' category: 'Interface-History'! HistoryCodeView comment: 'My instances represent the lower pane view and know about updating the content from the ChangesHistoryView (their models).'! !HistoryCodeView methodsFor: 'access'! fileIn "if the currentSelection is nil fileIn the tempFile, else fileIn the current entry." currentSelection isNil ifTrue:[model fileOutFile fileIn] ifFalse:[model model fileInEntryAt:currentSelection]! fileOut "if the currentSelection is nil fileIn the tempFile, else fileIn the current entry. " | fileName file | FillInTheBlank request: 'File name?' displayAt: Sensor cursorPoint centered: true action: [:answer | fileName_ answer] initialAnswer: ''. currentSelection isNil ifTrue: [model fileOutFile rename: fileName. model createTempFile.] ifFalse: [file _ FileStream fileNamed: fileName. model model fileOutEntryAt: currentSelection on:file. file close.] ! ! !HistoryCodeView methodsFor: 'update'! update: aSymbol "if the symbol is #fileOut then display the content of the just created file " aSymbol = #fileOut ifTrue: [self updateContentsFromFile: model fileOutFile] ifFalse: [super update: aSymbol]! updateContentsFromFile: aFile "display the content of the file" self editString: (aFile contentsOfEntireFile). currentSelection_nil. self displayView. ! updateDisplayContents "get the new selection, a ClassChanged object, from the model. And if it is really new get its content." | newSelection | newSelection_model selection. currentSelection == newSelection ifFalse:[self editString: (model model sourceStringOf:newSelection). currentSelection_newSelection. self displayView]. ! ! !HistoryCodeView methodsFor: 'default controller'! defaultControllerClass ^HistoryCodeController! ! "--- additional protocol for OrderedCollection ---"! !OrderedCollection methodsFor: 'accessing'! at: anInteger ifAbsent: aBlock "Answer my element at index anInteger. at: is used by a knowledgeable client to access an existing element" (anInteger < 1 or: [anInteger + firstIndex - 1 > lastIndex]) ifTrue: [^aBlock value] ifFalse: [^super at: anInteger + firstIndex - 1]! ! "---- I need with:with:with:with:with: ----"! !ArrayedCollection class methodsFor: 'instance creation'! with: firstObject with: secondObject with: thirdObject with: fourthObject with:fifthObject "Answer a new instance of me, containing only the five arguments as elements." | newCollection | newCollection _ self new: 5. newCollection at: 1 put: firstObject. newCollection at: 2 put: secondObject. newCollection at: 3 put: thirdObject. newCollection at: 4 put: fourthObject. newCollection at:5 put:fifthObject. ^newCollection! ! "--- Sometimes the paramBlock goes to nil, MAGIC ---"! !MacFileStream methodsFor: 'file access'! exists "Read file info and check for file found" paramBlock isNil ifTrue:[paramBlock _ MacParameterBlock forFile]. self doCommand: 14 with: nil with: nil. ^ paramBlock ioResult = 0! !