SystemOrganization addCategory: #'OB-Standard-Announcements'! SystemOrganization addCategory: #'OB-Standard-Browsers'! SystemOrganization addCategory: #'OB-Standard-Commands'! SystemOrganization addCategory: #'OB-Standard-Definitions'! SystemOrganization addCategory: #'OB-Standard-Filters'! SystemOrganization addCategory: #'OB-Standard-Nodes'! SystemOrganization addCategory: #'OB-Standard-Panels'! SystemOrganization addCategory: #'OB-Standard-Utilities'! OBTextPanel subclass: #OBAnnotationPanel instanceVariableNames: 'text process' classVariableNames: '' poolDictionaries: '' category: 'OB-Standard-Panels'! !OBAnnotationPanel methodsFor: 'callbacks' stamp: 'lr 5/2/2007 17:23'! accept: aString notifying: aController ^ false! ! !OBAnnotationPanel methodsFor: 'visiting' stamp: 'lr 11/17/2011 21:25'! acceptVisitor: aVisitor ^ aVisitor visitAnnotationPanel: self! ! !OBAnnotationPanel methodsFor: 'building' stamp: 'lr 2/26/2011 14:20'! buildOn: aBuilder ^ aBuilder textfield: self with: [ ]! ! !OBAnnotationPanel methodsFor: 'accessing' stamp: 'dr 4/11/2008 13:45'! environment ^ Smalltalk! ! !OBAnnotationPanel methodsFor: 'updating' stamp: 'cwp 11/10/2011 15:59'! nodeSelected: anAnnouncement process isNil ifFalse: [ process terminate ]. process := nil. anAnnouncement node isNil ifTrue: [ ^ self text: String new ]. process := [ self text: anAnnouncement node annotationString ] forkAt: Processor userBackgroundPriority! ! !OBAnnotationPanel methodsFor: 'accessing' stamp: 'lr 8/15/2010 17:53'! process ^ process! ! !OBAnnotationPanel methodsFor: 'callbacks' stamp: 'lr 5/2/2007 17:20'! selection ^ 1 to: 0! ! !OBAnnotationPanel methodsFor: 'updating' stamp: 'cwp 11/10/2011 16:01'! subscribe self announcer on: OBNodeSelected send: #nodeSelected: to: self! ! !OBAnnotationPanel methodsFor: 'callbacks' stamp: 'lr 5/2/2007 17:21'! text ^ text! ! !OBAnnotationPanel methodsFor: 'updating' stamp: 'lr 8/15/2010 17:41'! text: aString text := aString. self changed: #text! ! !OBAnnotationPanel methodsFor: 'building' stamp: 'lr 5/2/2007 17:19'! vResizing ^ #rigid! ! OBTextPanel subclass: #OBMercuryPanel instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'OB-Standard-Panels'! !OBMercuryPanel methodsFor: 'callbacks' stamp: 'lr 3/13/2010 13:13'! accept: aText notifying: anObject OBMercuryQuery find: aText asString withBlanksTrimmed for: self. self changed: #text! ! !OBMercuryPanel methodsFor: 'visiting' stamp: 'lr 11/17/2011 21:25'! acceptVisitor: aVisitor ^ aVisitor visitMercuryPanel: self! ! !OBMercuryPanel methodsFor: 'user interface' stamp: 'cwp 4/19/2007 22:30'! addTextCommandsToMenu: aMenu selection: aTextSelection! ! !OBMercuryPanel methodsFor: 'building' stamp: 'lr 2/26/2011 14:20'! buildOn: aBuilder ^ aBuilder textfield: self with: [ ]! ! !OBMercuryPanel methodsFor: 'private' stamp: 'cwp 7/20/2007 00:33'! environment ^ Smalltalk! ! !OBMercuryPanel methodsFor: 'callbacks' stamp: 'cwp 2/25/2007 19:44'! selection ^ 1 to: 0! ! !OBMercuryPanel methodsFor: 'actions' stamp: 'cwp 3/3/2007 00:28'! string: aString self systemNavigation browseMethodsWithString: aString! ! !OBMercuryPanel methodsFor: 'callbacks' stamp: 'cwp 2/25/2007 19:43'! text ^ ''! ! !OBMercuryPanel methodsFor: 'building' stamp: 'cwp 3/18/2007 20:54'! vResizing ^ #rigid! ! !OBIcon methodsFor: '*ob-standard' stamp: 'cwp 12/8/2011 12:26'! announcement width := 12. height := 12. bytes := #[255 243 247 250 255 139 172 206 255 90 136 185 255 108 149 192 255 108 149 192 255 90 136 185 255 139 172 206 255 243 247 250 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 255 147 177 209 255 169 193 218 255 253 254 254 255 255 255 255 255 255 255 255 255 253 254 254 255 169 193 218 255 147 177 209 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 255 92 138 186 255 251 252 253 255 240 246 254 255 232 241 254 255 229 240 254 255 233 242 254 255 253 254 254 255 90 136 185 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 255 88 135 184 255 255 255 255 255 233 242 254 255 230 240 254 255 226 238 254 255 223 236 254 255 255 255 255 255 88 135 184 0 0 0 0 0 0 0 0 255 233 239 246 0 0 0 0 255 88 135 184 255 255 255 255 255 230 241 254 255 227 239 254 255 224 237 254 255 220 235 253 255 255 255 255 255 88 135 184 0 0 0 0 255 163 189 216 255 110 151 193 0 0 0 0 255 88 135 184 255 255 255 255 255 228 239 254 255 224 237 254 255 221 235 254 255 217 233 253 255 255 255 255 255 157 184 213 255 111 151 194 255 153 182 212 255 190 208 227 0 0 0 0 255 88 135 184 255 255 255 255 255 225 238 254 255 221 236 254 255 218 233 253 255 214 231 253 255 226 238 254 255 255 255 255 255 231 238 245 255 95 140 187 0 0 0 0 0 0 0 0 255 88 135 184 255 255 255 255 255 222 236 254 255 219 234 253 255 215 232 253 255 211 230 253 255 208 227 253 255 255 255 255 255 157 184 213 255 181 202 224 0 0 0 0 0 0 0 0 255 88 135 184 255 255 255 255 255 219 234 253 255 215 232 253 255 212 230 253 255 208 228 253 255 233 242 254 255 239 243 248 255 93 139 186 0 0 0 0 0 0 0 0 0 0 0 0 255 88 135 184 255 255 255 255 255 220 234 253 255 213 230 253 255 209 228 253 255 209 228 252 255 255 255 255 255 157 184 213 255 173 196 220 0 0 0 0 0 0 0 0 0 0 0 0 255 133 167 203 255 180 201 223 255 255 255 255 255 255 255 255 255 255 255 255 255 255 255 255 255 180 201 223 255 117 156 196 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 255 231 238 245 255 112 152 194 255 123 160 199 255 137 170 205 255 137 170 205 255 125 162 200 255 112 152 194 255 231 238 245 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0]! ! !OBIcon methodsFor: '*ob-standard' stamp: 'cwp 12/8/2011 12:26'! arrowDown width := 12. height := 12. bytes := #[0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 255 255 255 255 255 255 255 255 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 255 255 255 255 255 99 143 69 255 255 255 255 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 255 255 255 255 255 255 255 255 255 255 255 255 255 255 255 255 255 99 143 69 255 99 143 69 255 255 255 255 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 255 255 255 255 255 99 143 69 255 99 143 69 255 99 143 69 255 99 143 69 255 146 205 94 255 99 143 69 255 255 255 255 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 255 255 255 255 255 99 143 69 255 143 205 83 255 144 205 84 255 150 212 88 255 153 215 90 255 146 205 94 255 99 143 69 255 255 255 255 0 0 0 0 0 0 0 0 0 0 0 0 255 255 255 255 255 99 143 69 255 146 205 94 255 146 205 94 255 144 196 105 255 147 205 95 255 124 174 90 255 99 143 69 255 255 255 255 0 0 0 0 0 0 0 0 0 0 0 0 255 255 255 255 255 99 143 69 255 99 143 69 255 99 143 69 255 99 143 69 255 139 197 89 255 99 143 69 255 255 255 255 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 255 255 255 255 255 255 255 255 255 255 255 255 255 255 255 255 255 99 143 69 255 99 143 69 255 255 255 255 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 255 255 255 255 255 99 143 69 255 255 255 255 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 255 255 255 255 255 255 255 255 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0]! ! !OBIcon methodsFor: '*ob-standard' stamp: 'cwp 12/8/2011 12:26'! arrowUp width := 12. height := 12. bytes := #[0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 255 255 255 255 255 255 255 255 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 255 255 255 255 255 99 143 69 255 255 255 255 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 255 255 255 255 255 99 143 69 255 99 143 69 255 255 255 255 255 255 255 255 255 255 255 255 255 255 255 255 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 255 255 255 255 255 99 143 69 255 146 205 94 255 99 143 69 255 99 143 69 255 99 143 69 255 99 143 69 255 255 255 255 0 0 0 0 0 0 0 0 0 0 0 0 255 255 255 255 255 99 143 69 255 146 205 94 255 153 215 90 255 150 212 88 255 144 205 84 255 143 205 83 255 99 143 69 255 255 255 255 0 0 0 0 0 0 0 0 0 0 0 0 255 255 255 255 255 99 143 69 255 124 174 90 255 147 205 95 255 144 196 105 255 146 205 94 255 146 205 94 255 99 143 69 255 255 255 255 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 255 255 255 255 255 99 143 69 255 139 197 89 255 99 143 69 255 99 143 69 255 99 143 69 255 99 143 69 255 255 255 255 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 255 255 255 255 255 99 143 69 255 99 143 69 255 255 255 255 255 255 255 255 255 255 255 255 255 255 255 255 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 255 255 255 255 255 99 143 69 255 255 255 255 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 255 255 255 255 255 255 255 255 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0]! ! !OBIcon methodsFor: '*ob-standard' stamp: 'cwp 12/8/2011 12:26'! arrowUpAndDown width := 12. height := 12. bytes := #[0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 255 255 255 255 255 255 255 255 255 255 255 255 255 255 255 255 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 255 255 255 255 255 99 143 69 255 255 255 255 255 255 255 255 255 99 143 69 255 255 255 255 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 255 255 255 255 255 99 143 69 255 99 143 69 255 255 255 255 255 255 255 255 255 99 143 69 255 99 143 69 255 255 255 255 0 0 0 0 0 0 0 0 0 0 0 0 255 255 255 255 255 99 143 69 255 146 205 94 255 99 143 69 255 99 143 69 255 99 143 69 255 99 143 69 255 146 205 94 255 99 143 69 255 255 255 255 0 0 0 0 255 255 255 255 255 99 143 69 255 146 205 94 255 153 215 90 255 150 212 88 255 144 205 84 255 143 205 83 255 150 212 88 255 153 215 90 255 146 205 94 255 99 143 69 255 255 255 255 255 255 255 255 255 99 143 69 255 124 174 90 255 147 205 95 255 144 196 105 255 146 205 94 255 146 205 94 255 144 196 105 255 147 205 95 255 124 174 90 255 99 143 69 255 255 255 255 0 0 0 0 255 255 255 255 255 99 143 69 255 139 197 89 255 99 143 69 255 99 143 69 255 99 143 69 255 99 143 69 255 139 197 89 255 99 143 69 255 255 255 255 0 0 0 0 0 0 0 0 0 0 0 0 255 255 255 255 255 99 143 69 255 99 143 69 255 255 255 255 255 255 255 255 255 99 143 69 255 99 143 69 255 255 255 255 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 255 255 255 255 255 99 143 69 255 255 255 255 255 255 255 255 255 99 143 69 255 255 255 255 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 255 255 255 255 255 255 255 255 255 255 255 255 255 255 255 255 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0]! ! !OBIcon methodsFor: '*ob-standard' stamp: 'cwp 12/8/2011 12:26'! breakpoint width := 12. height := 12. bytes := #[255 255 255 255 255 255 255 255 255 255 255 255 255 255 255 255 255 255 255 255 255 255 255 255 255 255 255 255 255 255 255 255 255 255 255 255 0 0 0 0 0 0 0 0 0 0 0 0 255 255 255 255 255 243 159 158 255 244 151 151 255 242 138 137 255 243 99 99 255 243 93 93 255 243 85 85 255 233 53 53 255 255 255 255 0 0 0 0 0 0 0 0 0 0 0 0 255 255 255 255 255 244 151 151 255 253 234 234 255 251 224 224 255 243 159 158 255 244 151 151 255 242 138 137 255 223 35 35 255 255 255 255 0 0 0 0 0 0 0 0 0 0 0 0 255 255 255 255 255 242 138 137 255 251 224 224 255 243 99 99 255 243 89 89 255 243 81 81 255 235 109 109 255 216 27 27 255 255 255 255 0 0 0 0 0 0 0 0 0 0 0 0 255 255 255 255 255 243 123 123 255 252 229 229 255 243 93 93 255 243 85 85 255 243 81 81 255 235 109 109 255 201 14 14 255 255 255 255 0 0 0 0 0 0 0 0 0 0 0 0 255 255 255 255 255 243 99 99 255 243 159 158 255 243 81 81 255 243 81 81 255 243 76 76 255 235 109 109 255 184 6 6 255 255 255 255 0 0 0 0 0 0 0 0 0 0 0 0 255 255 255 255 255 243 89 89 255 243 159 158 255 243 81 81 255 243 76 76 255 243 76 76 255 235 109 109 255 184 6 6 255 255 255 255 0 0 0 0 0 0 0 0 0 0 0 0 255 255 255 255 255 243 81 81 255 243 159 158 255 243 76 76 255 243 76 76 255 243 76 76 255 235 109 109 255 184 6 6 255 255 255 255 255 255 255 255 255 255 255 255 255 255 255 255 255 255 255 255 255 89 54 25 255 200 82 75 255 200 82 75 255 155 69 52 255 155 69 52 255 139 47 29 255 89 54 25 255 89 54 25 255 89 54 25 255 89 54 25 255 89 54 25 255 255 255 255 255 89 54 25 255 177 118 69 255 177 118 69 255 177 118 69 255 177 118 69 255 177 118 69 255 177 118 69 255 177 118 69 255 177 118 69 255 177 118 69 255 89 54 25 255 255 255 255 255 89 54 25 255 89 54 25 255 96 59 28 255 89 54 25 255 84 51 24 255 84 51 24 255 84 51 24 255 84 51 24 255 84 51 24 255 89 54 25 255 89 54 25 255 255 255 255 255 255 255 255 255 255 255 255 255 255 255 255 255 255 255 255 255 255 255 255 255 255 255 255 255 255 255 255 255 255 255 255 255 255 255 255 255 255 255 255 255 255 255 255]! ! !OBIcon methodsFor: '*ob-standard' stamp: 'cwp 12/8/2011 12:26'! collection width := 12. height := 12. bytes := #[255 255 243 235 255 255 173 119 255 255 147 78 255 255 173 119 255 255 242 233 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 255 255 177 126 255 248 156 97 255 234 161 114 255 239 148 89 255 255 174 122 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 255 255 145 73 255 232 160 113 255 222 150 104 255 212 141 95 255 255 142 69 0 0 0 0 255 253 250 238 255 243 222 135 255 240 212 98 255 243 222 135 255 253 250 236 0 0 0 0 255 255 177 126 255 236 145 86 255 210 138 91 255 226 135 76 255 255 174 122 0 0 0 0 255 244 224 140 255 237 214 119 255 228 210 136 255 228 205 111 255 244 223 137 0 0 0 0 255 255 243 235 255 255 170 115 255 255 145 73 255 255 170 115 255 255 242 233 0 0 0 0 255 239 211 94 255 225 207 135 255 216 198 126 255 206 188 117 255 239 210 90 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 255 244 224 140 255 226 203 108 255 205 187 113 255 216 193 98 255 244 223 137 0 0 0 0 0 0 0 0 255 239 246 238 255 142 194 135 255 107 175 99 255 142 194 135 255 237 245 236 255 253 250 238 255 243 221 131 255 239 211 94 255 243 221 131 255 253 250 236 0 0 0 0 0 0 0 0 255 147 197 141 255 139 190 129 255 164 197 154 255 131 181 121 255 144 195 137 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 255 104 173 95 255 163 195 153 255 156 187 146 255 146 177 136 255 100 171 91 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 255 147 197 141 255 127 178 118 255 143 175 133 255 119 168 108 255 144 195 137 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 255 239 246 238 255 138 192 132 255 104 173 95 255 138 192 132 255 237 245 236 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0]! ! !OBIcon methodsFor: '*ob-standard' stamp: 'cwp 12/8/2011 12:26'! exception width := 12. height := 12. bytes := #[0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 255 253 249 233 255 246 233 178 255 234 201 73 255 244 227 162 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 255 252 246 221 255 244 227 155 255 240 215 106 255 243 221 121 255 242 218 118 255 242 223 154 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 255 246 232 167 255 243 223 131 255 240 218 105 255 246 227 130 255 248 230 143 255 247 225 115 255 243 218 121 255 241 221 153 0 0 0 0 0 0 0 0 255 242 221 166 255 244 227 185 255 239 214 98 255 242 220 108 255 250 235 146 255 246 222 102 255 243 212 71 255 243 209 73 255 241 212 113 255 238 213 134 255 250 241 219 255 228 187 77 255 223 176 55 255 249 240 218 255 238 213 101 255 241 219 112 255 246 221 94 255 242 207 59 255 240 202 55 255 240 199 60 255 243 215 127 255 233 197 93 255 233 195 91 255 229 185 73 255 241 220 168 0 0 0 0 255 238 210 99 255 241 215 109 255 244 213 87 255 241 204 67 255 243 214 113 255 243 213 121 255 242 208 116 255 241 202 102 255 237 201 113 255 230 193 101 0 0 0 0 0 0 0 0 255 237 208 96 255 240 212 104 255 245 214 106 255 244 216 127 255 238 207 110 255 229 188 70 255 240 203 113 255 240 198 104 255 227 183 77 255 251 245 231 0 0 0 0 0 0 0 0 255 236 204 91 255 239 208 101 255 244 218 138 255 233 197 88 255 244 228 181 255 232 196 98 255 240 205 124 255 230 185 82 255 240 217 162 0 0 0 0 0 0 0 0 0 0 0 0 255 234 201 85 255 234 198 78 255 232 195 78 255 247 234 197 0 0 0 0 255 231 195 100 255 235 193 103 255 231 195 111 255 255 254 253 0 0 0 0 0 0 0 0 0 0 0 0 255 231 194 73 255 229 187 56 255 250 242 218 0 0 0 0 0 0 0 0 255 229 189 90 255 224 176 63 255 247 235 208 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 255 246 232 188 255 248 238 205 0 0 0 0 0 0 0 0 0 0 0 0 255 226 184 85 255 236 208 145 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 255 253 250 240 255 253 251 243 0 0 0 0 0 0 0 0 0 0 0 0 255 233 199 121 255 246 233 203 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0]! ! !OBIcon methodsFor: '*ob-standard' stamp: 'cwp 12/8/2011 12:26'! flag width := 12. height := 12. bytes := #[255 255 255 255 255 255 255 255 255 255 255 255 255 255 255 255 255 255 255 255 255 255 255 255 255 255 255 255 255 255 255 255 255 255 255 255 0 0 0 0 0 0 0 0 0 0 0 0 255 255 255 255 255 162 205 250 255 155 203 250 255 138 196 249 255 90 173 246 255 83 170 246 255 73 165 245 255 61 175 237 255 255 255 255 0 0 0 0 0 0 0 0 0 0 0 0 255 255 255 255 255 155 203 250 255 229 241 254 255 229 241 254 255 167 209 250 255 155 203 250 255 138 196 249 255 61 175 237 255 255 255 255 0 0 0 0 0 0 0 0 0 0 0 0 255 255 255 255 255 138 196 249 255 229 241 254 255 90 173 246 255 77 168 246 255 73 165 245 255 107 186 247 255 60 174 217 255 255 255 255 0 0 0 0 0 0 0 0 0 0 0 0 255 255 255 255 255 120 186 248 255 229 241 254 255 83 170 246 255 73 165 245 255 70 164 245 255 107 186 247 255 60 174 217 255 255 255 255 0 0 0 0 0 0 0 0 0 0 0 0 255 255 255 255 255 90 173 246 255 167 209 250 255 73 165 245 255 64 161 245 255 64 161 245 255 101 182 246 255 58 170 201 255 255 255 255 0 0 0 0 0 0 0 0 0 0 0 0 255 255 255 255 255 83 170 246 255 162 205 250 255 68 163 245 255 64 161 245 255 64 161 245 255 101 182 246 255 62 159 197 255 255 255 255 0 0 0 0 0 0 0 0 0 0 0 0 255 255 255 255 255 73 165 245 255 162 205 250 255 64 161 245 255 64 161 245 255 64 161 245 255 101 182 246 255 57 157 171 255 255 255 255 255 255 255 255 255 255 255 255 255 255 255 255 255 255 255 255 255 89 54 25 255 62 159 197 255 58 127 194 255 56 101 149 255 56 101 149 255 98 58 21 255 89 54 25 255 89 54 25 255 89 54 25 255 89 54 25 255 89 54 25 255 255 255 255 255 89 54 25 255 177 118 69 255 177 118 69 255 177 118 69 255 177 118 69 255 177 118 69 255 177 118 69 255 177 118 69 255 177 118 69 255 177 118 69 255 89 54 25 255 255 255 255 255 89 54 25 255 89 54 25 255 98 58 21 255 89 54 25 255 84 51 24 255 84 51 24 255 84 51 24 255 84 51 24 255 84 51 24 255 89 54 25 255 89 54 25 255 255 255 255 255 255 255 255 255 255 255 255 255 255 255 255 255 255 255 255 255 255 255 255 255 255 255 255 255 255 255 255 255 255 255 255 255 255 255 255 255 255 255 255 255 255 255 255]! ! !OBIcon methodsFor: '*ob-standard' stamp: 'cwp 12/8/2011 12:26'! magnitude width := 12. height := 12. bytes := #[0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 255 223 223 223 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 255 222 222 222 255 187 187 187 0 0 0 0 255 129 129 129 255 150 150 150 255 230 230 230 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 255 190 190 190 255 87 87 87 255 116 116 116 0 0 0 0 255 126 126 126 255 190 190 190 255 139 139 139 255 184 184 184 0 0 0 0 0 0 0 0 255 245 245 245 255 138 138 138 255 111 111 111 255 85 85 85 255 112 112 112 0 0 0 0 255 149 149 149 255 145 145 145 255 144 144 144 255 159 159 159 255 129 129 129 255 194 194 194 255 107 107 107 255 114 114 114 255 109 109 109 255 160 160 160 255 107 107 107 0 0 0 0 255 150 150 150 255 178 178 178 255 218 218 218 255 121 121 121 255 155 155 155 255 98 98 98 255 106 106 106 255 155 155 155 0 0 0 0 255 158 158 158 255 104 104 104 0 0 0 0 255 143 143 143 255 175 175 175 0 0 0 0 255 245 245 245 255 182 182 182 255 151 151 151 0 0 0 0 0 0 0 0 0 0 0 0 255 143 143 143 255 101 101 101 0 0 0 0 255 115 115 115 255 168 168 168 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 255 243 243 243 255 76 76 76 255 98 98 98 0 0 0 0 255 106 106 106 255 169 169 169 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 255 46 46 46 255 95 95 95 0 0 0 0 255 135 135 135 255 154 154 154 255 128 128 128 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 255 52 52 52 255 60 60 60 255 95 95 95 255 133 133 133 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0]! ! !OBIcon methodsFor: '*ob-standard' stamp: 'cwp 12/8/2011 12:26'! morph width := 12. height := 12. bytes := #[255 177 193 220 255 148 175 215 255 130 173 225 255 158 188 227 255 168 193 227 255 164 190 224 255 156 186 226 255 163 187 232 255 161 184 230 255 135 164 206 255 148 170 205 0 0 0 0 255 154 189 230 255 142 182 229 255 137 177 225 255 236 245 253 255 197 229 255 255 205 233 255 255 238 246 238 255 186 219 175 255 201 229 187 255 217 227 238 255 144 171 214 0 0 0 0 255 142 180 226 255 134 175 226 255 143 180 225 255 213 234 253 255 116 189 255 255 133 197 255 255 207 229 211 255 102 175 90 255 117 184 103 255 211 222 231 255 147 169 216 0 0 0 0 255 143 179 225 255 134 175 226 255 140 178 225 255 229 241 253 255 167 215 255 255 180 220 255 255 226 241 230 255 140 202 147 255 157 212 160 255 213 224 235 255 141 165 210 0 0 0 0 255 141 176 222 255 133 173 223 255 139 178 229 255 234 243 235 255 186 217 172 255 192 223 185 255 252 242 234 255 255 203 172 255 255 214 183 255 217 224 235 255 132 161 205 0 0 0 0 255 139 175 220 255 132 172 222 255 144 181 234 255 208 228 210 255 99 174 87 255 108 183 108 255 247 221 199 255 255 137 62 255 255 153 80 255 216 219 228 255 129 162 208 0 0 0 0 255 138 173 218 255 131 171 221 255 141 180 232 255 224 237 225 255 149 198 132 255 158 206 148 255 249 233 221 255 255 174 131 255 255 188 145 255 216 221 232 255 127 159 202 0 0 0 0 255 136 171 217 255 130 170 220 255 138 178 226 255 239 246 253 255 209 234 255 255 213 236 255 255 250 249 238 255 245 237 182 255 254 245 193 255 215 222 233 255 127 152 196 0 0 0 0 255 133 168 214 255 128 168 218 255 142 180 226 255 220 237 253 255 140 202 255 255 149 207 255 255 243 239 210 255 244 214 93 255 251 222 106 255 214 220 227 255 126 153 202 0 0 0 0 255 138 171 213 255 132 171 219 255 142 182 229 255 233 244 253 255 187 228 255 255 193 231 255 255 252 249 229 255 255 234 140 255 255 242 156 255 214 221 230 255 124 150 198 0 0 0 0 255 157 179 210 255 130 161 204 255 121 160 211 255 175 193 221 255 183 198 220 255 180 193 218 255 173 190 219 255 171 190 224 255 174 191 224 255 148 168 202 255 128 152 192 0 0 0 0 255 183 198 220 255 152 173 208 255 123 157 204 255 136 163 204 255 139 163 202 255 137 160 198 255 129 156 198 255 126 154 203 255 124 150 198 255 121 147 192 255 156 174 206 0 0 0 0]! ! !OBIcon methodsFor: '*ob-standard' stamp: 'cwp 12/8/2011 12:26'! string width := 12. height := 12. bytes := #[0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 255 211 229 249 255 107 181 239 255 112 184 239 255 116 178 239 255 240 246 253 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 255 111 180 239 255 133 196 242 255 146 200 243 255 127 190 241 255 122 177 238 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 255 112 186 241 255 146 201 243 255 146 200 243 255 145 199 243 255 113 181 239 255 240 245 253 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 255 112 184 239 255 137 195 242 255 136 194 242 255 136 194 242 255 126 187 241 255 109 171 237 255 113 171 237 255 113 168 237 255 113 166 236 255 111 165 236 255 111 164 236 255 111 162 236 255 112 183 239 255 116 177 239 255 115 175 239 255 115 174 239 255 114 172 237 255 113 171 237 255 113 168 237 255 113 168 236 255 112 166 236 255 111 165 236 255 111 163 236 255 111 162 236 255 112 183 239 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 255 112 183 239 255 115 175 239 255 114 174 239 255 114 172 237 255 113 171 237 255 113 168 237 255 113 168 236 255 112 166 236 255 111 165 236 255 111 163 236 255 111 161 236 255 110 160 236 255 115 175 239 255 115 174 239 255 114 174 237 255 113 171 237 255 113 169 237 255 113 168 236 255 112 166 236 255 111 165 236 255 111 163 236 255 111 162 236 255 110 161 236 255 110 160 234 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0]! ! !Morph class methodsFor: '*ob-standard' stamp: 'lr 3/28/2009 16:02'! browserIcon ^ #morph! ! !SystemOrganizer methodsFor: '*ob-standard-testing' stamp: 'cwp 9/18/2004 23:58'! isClassOrganizer ^ false! ! !TraitDescription methodsFor: '*ob-standard-converting' stamp: 'lr 2/19/2009 15:26'! asCommentNode ^ OBClassCommentNode on: self baseTrait! ! !TraitDescription methodsFor: '*ob-standard' stamp: 'lr 1/3/2010 16:11'! browserIcon ^ #blank! ! !TraitDescription methodsFor: '*ob-standard' stamp: 'lr 1/3/2010 16:12'! browserIcon: aClassDescription selector: aSelector ^ #blank! ! !ParserNotification methodsFor: '*ob-standard-handling' stamp: 'lr 10/20/2011 18:46'! handleWith: aMethodDefinition "Just an indirection through the OmniBrowser infrastructure." self openMenuIn: [ :labels :lines :caption | OBChoiceRequest prompt: caption labels: labels values: (1 to: labels size) lines: lines ]! ! !OBDefinitionPanel methodsFor: '*ob-standard-cmds' stamp: 'lr 12/10/2010 08:53'! browseIt: aSymbol | entry | entry := self environment at: aSymbol ifAbsent: [ nil ]. entry ifNil: [ ^ self implementorsOfIt: aSymbol ]. ((entry isKindOf: Class) or: [ entry isKindOf: Trait ]) ifFalse: [ entry := entry class ]. OBSystemBrowser openOnClass: entry. ^ true! ! !OBDefinitionPanel methodsFor: '*ob-standard-cmds' stamp: 'lr 12/10/2010 08:53'! environment ^ Smalltalk! ! !OBDefinitionPanel methodsFor: '*ob-standard-cmds' stamp: 'lr 12/10/2010 08:53'! implementorsOfIt: aSelector | node | node := OBSelectorNode on: aSelector. (self announce: (OBShowImplementors of: node)) execute. ^ true! ! !OBDefinitionPanel methodsFor: '*ob-standard-cmds' stamp: 'lr 12/10/2010 08:53'! methodStringsContainingIt: aString OBMethodStringsBrowser browseRoot: (OBSelectorNode on: aString). ^ true! ! !OBDefinitionPanel methodsFor: '*ob-standard-cmds' stamp: 'lr 12/10/2010 08:53'! referencesToIt: aClassName | class | class := self environment at: aClassName ifAbsent: [ nil ]. class isBehavior ifFalse: [ ^ self sendersOfIt: aClassName ]. OBReferencesBrowser browseRoot: (OBClassNode on: class). ^ true! ! !OBDefinitionPanel methodsFor: '*ob-standard-cmds' stamp: 'lr 12/10/2010 08:53'! sendersOfIt: aSelector | node | node := OBSelectorNode on: aSelector. (self announce: (OBShowSenders of: node)) execute. ^ true! ! !UndefinedObject methodsFor: '*ob-standard-testing' stamp: 'PDC 6/29/2007 06:02'! isClassBrowser ^false! ! !ClassOrganizer methodsFor: '*ob-standard-testing' stamp: 'cwp 9/18/2004 23:59'! isClassOrganizer ^ true! ! !String class methodsFor: '*ob-standard' stamp: 'lr 3/29/2009 14:20'! browserIcon ^ #string! ! !Collection class methodsFor: '*ob-standard' stamp: 'lr 3/28/2009 15:54'! browserIcon ^ #collection! ! !AnnouncementSet class methodsFor: '*ob-standard' stamp: 'lr 5/29/2010 08:17'! browserIcon ^ #announcement! ! !Magnitude class methodsFor: '*ob-standard' stamp: 'lr 7/10/2009 11:19'! browserIcon ^ #magnitude! ! !OBAnnouncement class methodsFor: '*ob-standard' stamp: 'cwp 12/8/2011 12:20'! browserIcon ^ #announcement! ! OBAnnouncement subclass: #OBNavigate instanceVariableNames: 'bid action label node' classVariableNames: '' poolDictionaries: '' category: 'OB-Standard-Announcements'! !OBNavigate class methodsFor: 'instance creation' stamp: 'dr 9/17/2008 14:02'! of: aNode ^ self new setRoot: aNode! ! !OBNavigate class methodsFor: 'instance creation' stamp: 'dr 2/10/2009 16:25'! of: aNode label: aString ^(self of: aNode) label: aString; yourself! ! !OBNavigate methodsFor: 'execution' stamp: 'lr 3/21/2009 20:03'! bid: anInteger toDo: aBlock anInteger > bid ifFalse: [ ^ self ]. bid := anInteger. action := aBlock! ! !OBNavigate methodsFor: 'accessing' stamp: 'lr 3/4/2009 22:08'! browserClass self subclassResponsibility! ! !OBNavigate methodsFor: 'configuration' stamp: 'cwp 11/8/2011 22:57'! defaultAction ^ [node childNodes isEmpty ifTrue: [OBInformRequest message: self noChildrenMessage] ifFalse: [self browserClass browseRoot: node label: self label]]! ! !OBNavigate methodsFor: 'configuration' stamp: 'dr 10/1/2007 16:28'! defaultMetaNode ^self browserClass defaultMetaNode! ! !OBNavigate methodsFor: 'execution' stamp: 'cwp 8/20/2007 22:51'! execute ^ action value! ! !OBNavigate methodsFor: 'initialize-release' stamp: 'cwp 8/20/2007 22:52'! initialize bid := 0. action := self defaultAction! ! !OBNavigate methodsFor: 'accessing' stamp: 'dr 2/10/2009 16:25'! label ^label! ! !OBNavigate methodsFor: 'accessing' stamp: 'dr 2/10/2009 16:25'! label: aString label := aString! ! !OBNavigate methodsFor: 'accessing' stamp: 'lr 3/4/2009 22:13'! noChildrenMessage self subclassResponsibility! ! !OBNavigate methodsFor: 'accessing' stamp: 'cwp 11/8/2011 22:57'! node ^ node! ! !OBNavigate methodsFor: 'accessing' stamp: 'cwp 11/8/2011 22:38'! setRoot: aNode node := aNode copy metaNode: self defaultMetaNode.! ! OBNavigate subclass: #OBShowHierarchyImplementors instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'OB-Standard-Announcements'! !OBShowHierarchyImplementors methodsFor: 'accessing' stamp: 'dr 9/21/2007 11:20'! browserClass ^ OBHierarchyImplementorsBrowser! ! !OBShowHierarchyImplementors methodsFor: 'accessing' stamp: 'lr 8/2/2010 16:41'! noChildrenMessage ^ 'No hierarchy implementors'! ! OBNavigate subclass: #OBShowHierarchySenders instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'OB-Standard-Announcements'! !OBShowHierarchySenders methodsFor: 'accessing' stamp: 'dr 9/21/2007 11:16'! browserClass ^ OBHierarchySendersBrowser! ! !OBShowHierarchySenders methodsFor: 'accessing' stamp: 'lr 8/2/2010 16:41'! noChildrenMessage ^ 'No hierarchy senders'! ! OBNavigate subclass: #OBShowImplementors instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'OB-Standard-Announcements'! !OBShowImplementors methodsFor: 'accessing' stamp: 'cwp 8/26/2007 00:34'! browserClass ^ OBImplementorsBrowser! ! !OBShowImplementors methodsFor: 'accessing' stamp: 'lr 8/2/2010 16:41'! noChildrenMessage ^ 'No implementors'! ! OBNavigate subclass: #OBShowSenders instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'OB-Standard-Announcements'! !OBShowSenders methodsFor: 'accessing' stamp: 'cwp 8/26/2007 00:33'! browserClass ^ OBSendersBrowser! ! !OBShowSenders methodsFor: 'accessing' stamp: 'lr 8/2/2010 16:42'! noChildrenMessage ^ 'No senders'! ! !OBVisitor methodsFor: '*ob-standard-visiting' stamp: 'lr 11/17/2011 21:28'! visitAnnotationPanel: anAnnotationPanel ^ self visitTextPanel: anAnnotationPanel! ! !OBVisitor methodsFor: '*ob-standard-visiting' stamp: 'lr 11/17/2011 21:34'! visitMercuryPanel: aMercuryPanel ^ self visitTextPanel: aMercuryPanel! ! !Trait methodsFor: '*ob-standard-converting' stamp: 'lr 2/19/2009 15:28'! asClassSideNode ^ OBMetaclassNode on: self! ! !Trait methodsFor: '*ob-standard-converting' stamp: 'lr 2/19/2009 15:28'! asNode ^ OBClassNode on: self! ! !Text class methodsFor: '*ob-standard' stamp: 'lr 5/29/2010 08:19'! browserIcon ^ #string! ! !UndefinedVariable methodsFor: '*ob-standard-handling' stamp: 'lr 10/20/2011 18:31'! handleWith: aMethodDefinition self resume: (OBConfirmationRequest prompt: name printString , ' appears to be undefined at this point. Proceed anyway?' confirm: 'Yes' cancel: 'No')! ! OBFilter subclass: #OBClassIconFilter instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'OB-Standard-Filters'! !OBClassIconFilter methodsFor: 'filtering' stamp: 'lr 5/4/2009 21:10'! clickIconColumn: aColumn forNode: aNode | filter classes choice index | filter := OBClassSortFilter new. OBWaitRequest block: [ classes := filter nodesFrom: aNode classHierarchy forNode: aNode ]. classes size < 2 ifTrue: [ ^ super clickIconColumn: aColumn forNode: aNode ]. index := classes indexOf: aNode ifAbsent: [ ^ false ]. choice := OBChoiceRequest prompt: 'Select Class' labels: (classes collect: [ :each | filter displayString: each theClassName forParent: aNode child: each ]) values: classes lines: (Array with: index - 1 with: index). choice isNil ifFalse: [ choice announceSelectionWith: aColumn browser ]. ^ true! ! !OBClassIconFilter methodsFor: 'filtering' stamp: 'lr 1/3/2010 16:11'! icon: aSymbol forNode: aNode ^ aNode theNonMetaClass browserIcon! ! OBFilter subclass: #OBClassSortFilter instanceVariableNames: 'indents order' classVariableNames: '' poolDictionaries: '' category: 'OB-Standard-Filters'! !OBClassSortFilter methodsFor: 'private' stamp: 'lr 4/3/2009 13:12'! buildIndentIndex indents := IdentityDictionary new. order do: [:assoc | indents at: assoc value put: assoc key size - 1].! ! !OBClassSortFilter methodsFor: 'private' stamp: 'cwp 5/20/2007 02:20'! collectSortedNodes ^order asArray collect: [:assoc | assoc value]! ! !OBClassSortFilter methodsFor: 'filtering' stamp: 'dr 9/17/2008 14:02'! displayString: aStringOrText forParent: pNode child: cNode | count indented | count := (indents at: cNode ifAbsent: [^ aStringOrText]) * 2. indented := String new: count + aStringOrText size. 1 to: count do: [:i | indented at: i put: $ ]. indented replaceFrom: count + 1 to: indented size with: aStringOrText. aStringOrText isText ifTrue: [ aStringOrText setString: indented setRuns: aStringOrText runs. ^aStringOrText ]. ^indented ! ! !OBClassSortFilter methodsFor: 'private' stamp: 'cwp 5/20/2007 02:20'! initializeResults | i chain2 chain1 result max | order := SortedCollection sortBlock: [:assoc1 :assoc2 | result := nil. chain1 := assoc1 key. chain2 := assoc2 key. max := chain1 size min: chain2 size. i := 1. [result isNil and: [i <= max]] whileTrue: [(chain1 at: i) = (chain2 at: i) ifTrue: [i := i + 1] ifFalse: [result := (chain1 at: i) name < (chain2 at: i) name]]. result isNil ifTrue: [chain1 size < chain2 size] ifFalse: [result]]! ! !OBClassSortFilter methodsFor: 'filtering' stamp: 'lr 11/17/2010 16:04'! nodesFrom: nodes forNode: parent "Sort nodes according to their position in the class hierarchy" | classes supersChain | self initializeResults. classes := nodes collect: [ :classNode | classNode theClass ]. classes isEmpty ifTrue: [ ^ nodes ]. classes := classes size < 10 ifTrue: [ classes asArray ] ifFalse: [ classes asSet ]. nodes do: [ :classNode | supersChain := classNode theClass withAllSuperclasses reversed. supersChain removeAllSuchThat: [ :class | (classes includes: class) not ]. order add: supersChain contents -> classNode ]. self buildIndentIndex. ^ self collectSortedNodes! ! OBFilter subclass: #OBMethodIconFilter instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'OB-Standard-Filters'! !OBMethodIconFilter methodsFor: 'filtering' stamp: 'lr 8/1/2010 15:32'! clickIconColumn: aColumn forNode: aNode | filter implementors choice index | aColumn browser isClassBrowser ifFalse: [ ^ false ]. filter := OBClassSortFilter new. OBWaitRequest block: [ implementors := filter nodesFrom: aNode hierarchyImplementors forNode: aNode ]. implementors size < 2 ifTrue: [ ^ super clickIconColumn: aColumn forNode: aNode ]. index := implementors indexOf: aNode ifAbsent: [ ^ false ]. choice := OBChoiceRequest prompt: 'Select Implementor' labels: (implementors collect: [ :each | filter displayString: each theClassName forParent: aNode child: each ]) values: implementors lines: (Array with: index - 1 with: index). choice isNil ifFalse: [ choice announceSelectionWith: aColumn browser ]. ^ true! ! !OBMethodIconFilter methodsFor: 'filtering' stamp: 'lr 1/3/2010 16:12'! icon: aSymbol forNode: aNode ^ aNode theNonMetaClass browserIcon: aNode theClass selector: aNode selector! ! !Announcement class methodsFor: '*ob-standard' stamp: 'lr 5/29/2010 08:17'! browserIcon ^ #announcement! ! OBNode subclass: #OBCodeNode instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'OB-Standard-Nodes'! !OBCodeNode commentStamp: 'cwp 1/8/2005 11:12' prior: 0! OBCodeNode is an abstract superclass for node classes that represent program elements active in the image. Though it provides little functionality, it exists for structural purposes.! OBCodeNode subclass: #OBClassAwareNode instanceVariableNames: 'theClass' classVariableNames: '' poolDictionaries: '' category: 'OB-Standard-Nodes'! !OBClassAwareNode commentStamp: 'cwp 1/8/2005 11:23' prior: 0! OBClassAware node models program elements that are part of a class. It provides methods for manipulating the class, as well as methods relating to sorting according to class hierarchy. iVars theClass - the class that this node is part of superior - during hierarchical sorting this refers to the nearest superclass that belongs to the group being sorted! !OBClassAwareNode class methodsFor: 'sorting' stamp: 'dr 10/24/2008 18:55'! sortHierarchicallyOptimized: nodes "Reimplements sortHierarchically in a crude and ugly way that is however much more efficient" | classNodes sortedResults supersChain superior result chain1 chain2 i max | classNodes := (nodes collect: [:classNode | classNode theClass]) asOrderedCollection. sortedResults := SortedCollection sortBlock: [:assoc1 :assoc2 | result := nil. chain1 := assoc1 key. chain2 := assoc2 key. max := chain1 size min: chain2 size. i := 1. [result isNil and: [i <= max]] whileTrue: [ (chain1 at: i) = (chain2 at: i) ifTrue: [i := i + 1] ifFalse: [result := (chain1 at: i) name < (chain2 at: i) name]]. result isNil ifTrue: [ chain1 size < chain2 size] ifFalse: [result] ]. nodes do: [:classNode | supersChain := classNode theClass withAllSuperclasses reversed. supersChain removeAllSuchThat: [:cl | (classNodes includes: cl) not]. superior := supersChain size > 1 ifTrue: [superior := supersChain atLast: 2. nodes detect: [:e | e theClass = superior]] ifFalse: [nil]. sortedResults add: supersChain contents -> classNode. ]. ^(sortedResults collect: [:assoc | assoc value]) asArray! ! !OBClassAwareNode methodsFor: 'comparing' stamp: 'lr 4/9/2011 17:30'! = aNode ^ self species = aNode species and: [ self theClass = aNode theClass ]! ! !OBClassAwareNode methodsFor: 'navigating' stamp: 'lr 2/17/2009 20:43'! allCategories "Return all categories of theClass and its superclasses." | categories | categories := self theClass withAllSuperclasses inject: Set new into: [ :result :class | result addAll: class organization categories; yourself ]. ^ OrderedCollection new add: (OBAllMethodCategoryNode on: self theClass); addAll: (categories asSortedCollection collect: [ :category | OBMethodCategoryNode on: category inClass: self theClass ]); yourself! ! !OBClassAwareNode methodsFor: 'accessing' stamp: 'lr 3/13/2010 11:53'! annotationString ^ 'Class definition for ' , self theClassName! ! !OBClassAwareNode methodsFor: 'actions' stamp: 'lr 10/8/2010 08:44'! browse OBSystemBrowser openOnClass: self theNonMetaClass! ! !OBClassAwareNode methodsFor: 'actions' stamp: 'lr 9/23/2010 11:35'! browseHierarchy OBHierarchyBrowser openOnClass: self theClass! ! !OBClassAwareNode methodsFor: 'nodes' stamp: 'dvf 8/31/2005 13:11'! classNode ^self theClass asNode! ! !OBClassAwareNode methodsFor: 'actions' stamp: 'lr 6/12/2010 15:20'! focusHierarchy: aColumn self theClass isTrait ifTrue: [ ^ self ]. aColumn parent setClass: self copy. aColumn browser signalRefresh! ! !OBClassAwareNode methodsFor: 'comparing' stamp: 'lr 4/9/2011 17:30'! hash ^ self theClass hash! ! !OBClassAwareNode methodsFor: 'testing' stamp: 'lr 3/13/2010 12:09'! isBrowsable ^ true! ! !OBClassAwareNode methodsFor: 'ancestry' stamp: ''! isDescendantOfClass: aClassNode ^ self theClassName = aClassNode theClassName! ! !OBClassAwareNode methodsFor: 'ancestry' stamp: 'lr 8/29/2010 11:41'! isDescendantOfClassCat: aClassCategoryNode ^ self theNonMetaClass category = aClassCategoryNode name! ! !OBClassAwareNode methodsFor: 'accessing' stamp: ''! theClass ^ theClass! ! !OBClassAwareNode methodsFor: 'accessing' stamp: ''! theClass: aClass theClass := aClass! ! !OBClassAwareNode methodsFor: 'accessing' stamp: ''! theClassName ^ self theClass name! ! !OBClassAwareNode methodsFor: 'accessing' stamp: ''! theMetaClass ^ self theClass theMetaClass! ! !OBClassAwareNode methodsFor: 'accessing' stamp: ''! theNonMetaClass ^ self theClass theNonMetaClass! ! !OBClassAwareNode methodsFor: 'accessing' stamp: ''! theNonMetaClassName ^ self theNonMetaClass name! ! !OBClassAwareNode methodsFor: 'displaying' stamp: 'lr 8/19/2009 22:24'! title ^ self theNonMetaClassName! ! OBClassAwareNode subclass: #OBClassCommentNode instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'OB-Standard-Nodes'! !OBClassCommentNode commentStamp: 'cwp 1/8/2005 11:24' prior: 0! OBClassCommentNode represents the comment attached to a particular class. ! !OBClassCommentNode class methodsFor: 'instance creation' stamp: ''! on: classRef ^ self new setClass: classRef! ! !OBClassCommentNode methodsFor: 'definition' stamp: 'jk 8/23/2007 17:16'! definition ^ OBClassCommentDefinition on: self theClass! ! !OBClassCommentNode methodsFor: 'public' stamp: 'cwp 12/13/2004 00:51'! name ^ self theClass name! ! !OBClassCommentNode methodsFor: 'initializing' stamp: ''! setClass: aClass self theClass: aClass! ! OBClassAwareNode subclass: #OBClassNode instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'OB-Standard-Nodes'! !OBClassNode commentStamp: 'lr 8/4/2007 10:30' prior: 0! OBClassNode wraps a class for display in various types of code browsers. It provides many navigation methods for the different types of browsers where classes may appear. The instance-variable theClass is always a non-metaclass.! !OBClassNode class methodsFor: 'instance creation' stamp: 'cwp 11/30/2004 21:06'! on: aClass ^ self new setClass: aClass ! ! !OBClassNode methodsFor: 'navigating' stamp: 'cwp 12/12/2011 16:46'! allCategory ^ OBAllMethodCategoryNode on: self theClass! ! !OBClassNode methodsFor: 'ancestry' stamp: ''! ancestrySelector ^ #isDescendantOfClass:! ! !OBClassNode methodsFor: 'navigating' stamp: 'lr 2/17/2009 20:47'! categories | categories publicCategories privateCategories | categories := self theClass organization categories. publicCategories := categories reject: [ :each | each beginsWith: #private ]. privateCategories := categories select: [ :each | each beginsWith: #private ]. ^ publicCategories sort , privateCategories sort collect: [ :each | OBMethodCategoryNode on: each inClass: self theClass ]! ! !OBClassNode methodsFor: 'nodes' stamp: 'dr 7/4/2008 16:49'! categoryNodeNamed: aString ^ OBMethodCategoryNode on: aString inClass: theClass! ! !OBClassNode methodsFor: 'navigating' stamp: 'cwp 12/12/2004 23:31'! classHierarchy ^ self nodeHierarchyWithClass: OBClassNode! ! !OBClassNode methodsFor: 'navigating' stamp: 'lr 11/7/2009 17:47'! classVariables ^ self theNonMetaClass allClassVarNames asArray sort collect: [:ea | OBClassVariableNode on: ea inClass: self theClass]! ! !OBClassNode methodsFor: 'navigating' stamp: 'cwp 12/12/2004 23:31'! commentHierarchy ^ self nodeHierarchyWithClass: OBClassCommentNode! ! !OBClassNode methodsFor: 'accessing' stamp: ''! definition ^ OBClassDefinition environment: self theClass environment template: self theClass definition! ! !OBClassNode methodsFor: 'drag and drop' stamp: 'lr 3/28/2006 18:29'! dropOnClassCategory: aNode self theNonMetaClass category: aNode name. self signalSelection. ^ true! ! !OBClassNode methodsFor: 'drag and drop' stamp: 'lr 4/6/2006 11:31'! dropSelector ^ #dropOnClass:! ! !OBClassNode methodsFor: 'commands' stamp: 'dr 7/10/2008 16:26'! fileOut self theNonMetaClass fileOut! ! !OBClassNode methodsFor: 'testing' stamp: 'cwp 6/30/2006 00:57'! hasOrganization ^ true! ! !OBClassNode methodsFor: 'navigating' stamp: ''! instanceVariables ^ self theClass allInstVarNames asArray sort collect: [:ea | OBInstanceVariableNode on: ea inClass: self theClass]! ! !OBClassNode methodsFor: 'testing' stamp: 'dr 11/28/2007 14:57'! isClassNode ^true! ! !OBClassNode methodsFor: 'ancestry' stamp: 'dr 12/2/2008 18:42'! isDescendantOfMethodCat: category ^ false! ! !OBClassNode methodsFor: 'navigating' stamp: 'cwp 12/12/2004 23:30'! metaclassHierarchy ^ self nodeHierarchyWithClass: OBMetaclassNode! ! !OBClassNode methodsFor: 'accessing' stamp: 'lr 2/9/2008 09:18'! methods ^ self theClass selectors collect: [ :each | (MethodReference class: self theClass selector: each) asNode ]! ! !OBClassNode methodsFor: 'displaying' stamp: 'dr 9/15/2008 17:13'! name ^ self theClass name! ! !OBClassNode methodsFor: 'navigating' stamp: 'cwp 5/20/2007 00:27'! nodeHierarchyWithClass: aClass ^ self surroundingHierarchy collect: [:ea | aClass on: ea]! ! !OBClassNode methodsFor: 'accessing' stamp: ''! organization ^ self theClass organization! ! !OBClassNode methodsFor: 'printing' stamp: 'cwp 12/10/2004 23:53'! printOn: aStream aStream print: self class; nextPut: $<; print: self theClass; nextPut: $>! ! !OBClassNode methodsFor: 'initializing' stamp: 'lr 8/4/2007 10:29'! setClass: aClass self theClass: aClass theNonMetaClass! ! !OBClassNode methodsFor: 'accessing' stamp: 'dr 10/23/2008 13:28'! surroundingHierarchy | class result | result := OrderedCollection new. class := self theNonMetaClass. class allSuperclasses reverseDo: [:aClass | result add: aClass]. class allSubclassesWithLevelDo: [:aClass :level | result add: aClass] startingLevel: 0. ^ result! ! !OBClassNode methodsFor: 'navigating' stamp: 'cwp 12/12/2011 16:46'! syntheticCategories ^ Array with: self allCategory! ! !OBClassNode methodsFor: 'navigating' stamp: 'cwp 10/17/2007 23:58'! users | nodes | nodes := (SystemNavigation default allCallsOn: (theClass environment associationAt: theClass name)) collect: [:ref | OBClassRefNode on: self name inMethod: ref]. ^ nodes asArray sort: [:a :b | a theClassName <= b theClassName]! ! OBClassNode subclass: #OBMetaclassNode instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'OB-Standard-Nodes'! !OBMetaclassNode commentStamp: 'lr 8/4/2007 10:30' prior: 0! OBMetaclassNode is essentially the same as an OBClassNode, but overrides a few methods to work properly with metaclasses. The instance-variable theClass is always a metaclass.! !OBMetaclassNode methodsFor: 'displaying' stamp: 'cwp 12/13/2004 00:56'! name ^ self nonMetaName! ! !OBMetaclassNode methodsFor: 'displaying' stamp: ''! nonMetaName ^ self theNonMetaClass name! ! !OBMetaclassNode methodsFor: 'initializing' stamp: 'lr 8/4/2007 10:29'! setClass: aClass self theClass: aClass theMetaClass! ! OBClassAwareNode subclass: #OBMethodCategoryNode instanceVariableNames: 'name' classVariableNames: '' poolDictionaries: '' category: 'OB-Standard-Nodes'! !OBMethodCategoryNode commentStamp: 'cwp 1/8/2005 12:29' prior: 0! OBMethodCategory represents a category within a ClassOrganization. Instead of an organization definition, OBMethodCategory presents a MethodDefinition with the class' default method template.! OBMethodCategoryNode subclass: #OBAllMethodCategoryNode instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'OB-Standard-Nodes'! !OBAllMethodCategoryNode commentStamp: 'cwp 1/8/2005 12:31' prior: 0! OBAllMethodCategory implements the synthetic '-- all --' category, which contains all the methods in a class.! !OBAllMethodCategoryNode class methodsFor: 'instance creation' stamp: ''! on: className ^ self on: '-- all --' inClass: className! ! !OBAllMethodCategoryNode methodsFor: 'accessing' stamp: ''! category ^ 'as yet unclassified'! ! !OBAllMethodCategoryNode methodsFor: 'accessing' stamp: 'lr 4/23/2010 08:34'! methodReferences ^ self theClass selectors asArray sort collect: [ :each | MethodReference class: self theClass selector: each ]! ! !OBMethodCategoryNode class methodsFor: 'instance creation' stamp: ''! on: aString inClass: aClassReference ^ self new setName: aString class: aClassReference! ! !OBMethodCategoryNode methodsFor: 'comparing' stamp: 'lr 4/9/2011 17:31'! = aNode ^ super = aNode and: [ self name = aNode name ]! ! !OBMethodCategoryNode methodsFor: 'navigating' stamp: 'lr 2/17/2009 20:49'! allMethods | allMethods | allMethods := OrderedCollection new. self theClass withAllSuperclassesDo: [ :class | class methodDict keysAndValuesDo: [ :selector :method | self name = (class organization categoryOfElement: selector) ifTrue: [ allMethods add: selector] ] ]. ^ allMethods collect: [ :selector | OBMethodNode on: selector inClass: (self theClass whichClassIncludesSelector: selector) ]! ! !OBMethodCategoryNode methodsFor: 'ancestry' stamp: ''! ancestrySelector ^ #isDescendantOfMethodCat:! ! !OBMethodCategoryNode methodsFor: 'actions' stamp: 'lr 10/8/2010 08:44'! browse OBSystemBrowser openOnClass: self theClass category: self name! ! !OBMethodCategoryNode methodsFor: 'actions' stamp: 'lr 9/23/2010 11:38'! browseHierarchy OBHierarchyBrowser openOnClass: self theClass category: self name! ! !OBMethodCategoryNode methodsFor: 'accessing' stamp: ''! category ^ name! ! !OBMethodCategoryNode methodsFor: 'accessing' stamp: ''! container ^ self theClass! ! !OBMethodCategoryNode methodsFor: 'public' stamp: ''! definition ^ OBMethodDefinition inCategory: self category inClass: self theClass! ! !OBMethodCategoryNode methodsFor: 'drag and drop' stamp: 'lr 4/6/2006 11:46'! dropOnClass: aNode self methods do: [ :each | each dropOnClass: aNode ]. aNode signalChildrenChanged. ^ true! ! !OBMethodCategoryNode methodsFor: 'drag and drop' stamp: ''! dropSelector ^ #dropOnMethodCategory:! ! !OBMethodCategoryNode methodsFor: 'services' stamp: ''! fileOut self theClass fileOutCategory: name! ! !OBMethodCategoryNode methodsFor: 'comparing' stamp: 'lr 4/9/2011 17:31'! hash ^ super hash bitXor: self name hash! ! !OBMethodCategoryNode methodsFor: 'testing' stamp: 'dr 10/30/2008 10:23'! isCategoryNode ^true! ! !OBMethodCategoryNode methodsFor: 'ancestry' stamp: ''! isDescendantOfMethodCat: other ^ (other theClassName = self theClassName) and: [other name = name]! ! !OBMethodCategoryNode methodsFor: 'testing' stamp: 'dr 10/30/2008 09:49'! isMethodCategoryNode ^true! ! !OBMethodCategoryNode methodsFor: 'accessing' stamp: 'cwp 9/14/2005 09:06'! methodReferences ^ (self theClass organization listAtCategoryNamed: name) collect: [:ea | MethodReference new setClassSymbol: self theNonMetaClassName classIsMeta: self theClass isMeta methodSymbol: ea stringVersion: ''] ! ! !OBMethodCategoryNode methodsFor: 'navigating' stamp: 'dvf 8/19/2005 17:16'! methods ^ self methodReferences collect: [:ref | ref asNode]! ! !OBMethodCategoryNode methodsFor: 'public' stamp: 'dr 7/18/2007 11:51'! name ^name! ! !OBMethodCategoryNode methodsFor: 'accessing' stamp: 'dvf 8/16/2005 17:47'! printOn: aStream super printOn: aStream. aStream nextPut: $<. self name printOn: aStream. aStream nextPut: $>.! ! !OBMethodCategoryNode methodsFor: 'actions' stamp: 'lr 11/25/2010 23:49'! remove self theClass removeCategory: name! ! !OBMethodCategoryNode methodsFor: 'actions' stamp: 'cwp 6/11/2009 16:59'! renameTo: aString self container organization renameCategory: self name toBe: aString.! ! !OBMethodCategoryNode methodsFor: 'accessing' stamp: 'dr 2/4/2009 20:55'! setName: aString name := aString! ! !OBMethodCategoryNode methodsFor: 'initializing' stamp: ''! setName: aString class: aClass name := aString. self theClass: aClass! ! OBClassAwareNode subclass: #OBMethodNode instanceVariableNames: 'selector' classVariableNames: '' poolDictionaries: '' category: 'OB-Standard-Nodes'! !OBMethodNode commentStamp: 'cwp 1/8/2005 12:37' prior: 0! OBMethodNode wraps a method in a particular class. It supplies an OBMethodDefinition for displaying and editing the source code of the method, and various actions for manipulating the method. It has two roles: first it appears in the right most pane of a standard system browser. Second, it often serves as the root node for an OBListBrowser, and has navigation methods for senders, implementors etc. OBMethodNode also serves as the superclass for nodes that represent *parts* of a method, such as sends of a particular message, references to a class, accesses to a instance variable, etc.! OBMethodNode subclass: #OBClassRefNode instanceVariableNames: 'className' classVariableNames: '' poolDictionaries: '' category: 'OB-Standard-Nodes'! !OBClassRefNode commentStamp: 'cwp 1/8/2005 12:38' prior: 0! Each instance of OBClassRefNode refers to a reference to a particular class from the source code of a method. It's used in the OBListBrowser created by the 'browse references' class action.! !OBClassRefNode class methodsFor: 'instance creation' stamp: 'cwp 12/1/2004 00:50'! on: aClassName inMethod: aMethodRef ^ self new setClassName: aClassName reference: aMethodRef! ! !OBClassRefNode methodsFor: 'accessing' stamp: 'cwp 12/8/2004 22:14'! name ^ className! ! !OBClassRefNode methodsFor: 'accessing' stamp: 'cwp 12/1/2004 01:16'! selection | start parser | (parser := Compiler parserClass new) parseSelector: self source. start := parser endOfLastToken. start := (self source asString findString: className startingAt: start). ^ start to: start + className size - 1! ! !OBClassRefNode methodsFor: 'initialize-release' stamp: 'cwp 12/1/2004 01:10'! setClassName: theName reference: aMethodRef self setReference: aMethodRef. className := theName. ! ! OBMethodNode subclass: #OBMessageNode instanceVariableNames: 'message' classVariableNames: '' poolDictionaries: '' category: 'OB-Standard-Nodes'! !OBMessageNode commentStamp: 'cwp 1/8/2005 12:40' prior: 0! An OBMessageNode refers to a message send in the source code of a method. They are typically used in the 'senders' browser.! !OBMessageNode class methodsFor: 'instance creation' stamp: ''! fromMethodNode: aMethodNode ^ self new setMessage: aMethodNode selector selector: aMethodNode selector class: aMethodNode theClass! ! !OBMessageNode class methodsFor: 'instance creation' stamp: ''! on: aSelector inMethod: aSelector2 inClass: classRef ^ self new setMessage: aSelector selector: aSelector2 class: classRef! ! !OBMessageNode class methodsFor: 'instance creation' stamp: ''! on: aSelector inMethodNode: aNode ^ self on: aSelector inMethod: aNode selector inClass: aNode theClass! ! !OBMessageNode class methodsFor: 'instance creation' stamp: 'lr 2/12/2009 10:39'! on: aSelector inMethodReference: ref ^ self on: aSelector inMethod: ref methodSymbol inClass: ref actualClass! ! !OBMessageNode methodsFor: 'navigating' stamp: ''! implementors ^ self implementorsOf: message! ! !OBMessageNode methodsFor: 'displaying' stamp: 'cwp 12/8/2004 21:26'! name ^ message! ! !OBMessageNode methodsFor: 'accessing' stamp: 'cwp 7/18/2007 19:31'! selection | methodNode assoc | methodNode := Parser new parse: self source class: self theClass. assoc := (methodNode encoder rawSourceRanges) associations detect: [:ea | ea key selectorIs: message] ifNone: [nil -> (1 to: 0)]. "Some messages are generated by the compiler." ^ assoc value! ! !OBMessageNode methodsFor: 'initializing' stamp: ''! setMessage: aSelector selector: aSelector2 class: aClass message := aSelector. selector := aSelector2. self theClass: aClass! ! !OBMessageNode methodsFor: 'accessing' stamp: 'lr 8/2/2010 16:00'! unifySelectors selector := message! ! !OBMethodNode class methodsFor: 'instance creation' stamp: ''! on: aMethodReference ^ self new setReference: aMethodReference! ! !OBMethodNode class methodsFor: 'instance creation' stamp: 'dr 1/9/2008 14:18'! on: aSelector inClass: aClassReference ^ self new setSelector: aSelector class: aClassReference! ! !OBMethodNode methodsFor: 'comparing' stamp: 'lr 4/9/2011 17:32'! = aNode ^ super = aNode and: [ self selector = aNode selector ]! ! !OBMethodNode methodsFor: 'private' stamp: ''! addOverridersOf: aSelector inClass: aClass to: aCollection aClass subclasses do: [:ea | (ea includesSelector: aSelector) ifTrue: [aCollection add: ea] ifFalse: [self addOverridersOf: aSelector inClass: ea to: aCollection]]! ! !OBMethodNode methodsFor: 'ancestry' stamp: ''! ancestrySelector ^ #isDescendantOfMethod: ! ! !OBMethodNode methodsFor: 'displaying' stamp: 'lr 3/13/2010 11:50'! annotationString ^ (OBAnnotationRequest onClass: self theClass selector: self selector) getAnnotations! ! !OBMethodNode methodsFor: 'actions' stamp: 'lr 10/8/2010 08:44'! browse OBSystemBrowser openOnClass: self theClass selector: self selector! ! !OBMethodNode methodsFor: 'actions' stamp: 'lr 9/23/2010 11:39'! browseHierarchy OBHierarchyBrowser openOnClass: self theClass selector: self selector! ! !OBMethodNode methodsFor: 'accessing' stamp: 'lr 2/12/2009 10:41'! category ^ [ self reference category ifNil: [ '' ] ] on: Error do: [ :err | '' ]! ! !OBMethodNode methodsFor: 'private' stamp: 'lr 2/12/2009 10:41'! defaultSource ^ String streamContents: [ :stream | self writeMethodHeaderTo: stream. stream nextPut: Character cr; tab; nextPutAll: '"This method does not exist."'; nextPut: Character cr; tab; nextPutAll: 'self halt.' ]! ! !OBMethodNode methodsFor: 'accessing' stamp: 'cwp 12/1/2004 00:36'! definition ^ OBMethodDefinition selection: self selection source: self source inClass: self theClass! ! !OBMethodNode methodsFor: 'displaying' stamp: 'lr 7/3/2009 21:59'! displayString ^ (self theClass includesLocalSelector: selector) ifTrue: [ super displayString ] ifFalse: [ super displayString asText addAttribute: TextEmphasis italic ]! ! !OBMethodNode methodsFor: 'drag and drop' stamp: 'lr 5/28/2010 13:54'! dropOnClass: aNode aNode theClass compile: self source classified: (self theClass organization categoryOfElement: self selector). (Sensor shiftPressed or: [ self theClass = aNode theClass ]) ifFalse: [ self theClass removeSelector: self selector ]. aNode signalChildrenChanged. ^ true! ! !OBMethodNode methodsFor: 'drag and drop' stamp: 'lr 5/28/2010 14:00'! dropOnMethodCategory: aNode aNode theClass = self theClass ifTrue: [ self theClass organization classify: self selector under: aNode category suppressIfDefault: false ] ifFalse: [ aNode theClass compile: self source classified: aNode category. Sensor shiftPressed ifFalse: [ self theClass removeSelector: self selector ] ]. aNode signalChildrenChanged. ^ true! ! !OBMethodNode methodsFor: 'actions' stamp: ''! fileOut self theClass fileOutMethod: selector! ! !OBMethodNode methodsFor: 'displaying' stamp: 'cwp 12/8/2004 21:08'! fullName ^ self theClassName, '>>', selector! ! !OBMethodNode methodsFor: 'displaying' stamp: 'cwp 6/11/2009 15:25'! fullNameWithProtocol ^ self fullName , ' {' , self category , '}'! ! !OBMethodNode methodsFor: 'testing' stamp: 'cwp 10/11/2006 20:46'! hasSelector ^ true! ! !OBMethodNode methodsFor: 'testing' stamp: 'cwp 10/9/2006 18:13'! hasVersions ^ true! ! !OBMethodNode methodsFor: 'comparing' stamp: 'lr 4/9/2011 17:32'! hash ^ super hash bitXor: self selector hash! ! !OBMethodNode methodsFor: 'navigating' stamp: 'dr 7/2/2007 17:10'! hierarchyImplementors ^OBClassAwareNode sortHierarchicallyOptimized: (self hierarchyImplementorsOf: selector)! ! !OBMethodNode methodsFor: 'private' stamp: 'lr 3/27/2010 20:02'! hierarchyImplementorsOf: aSelector | classCollection addBlock | classCollection := SortedCollection new. addBlock := [ :class | (class includesSelector: aSelector) ifTrue: [ classCollection add: (MethodReference new setStandardClass: class methodSymbol: aSelector) ] ]. self theClass allSuperclassesDo: addBlock. addBlock value: self theClass. self theClass allSubclassesDo: addBlock. ^ classCollection collect: [ :ref | ref asNode ]! ! !OBMethodNode methodsFor: 'navigating' stamp: 'dr 7/2/2007 17:10'! hierarchySenders ^self hierarchySendersOf: selector! ! !OBMethodNode methodsFor: 'private' stamp: 'lr 4/23/2010 08:35'! hierarchySendersOf: aSelector | hierarchySenders | hierarchySenders := (SystemNavigation default allCallsOn: aSelector) select: [:ea | (self theClass withAllSuperclasses includes: ea actualClass) or: [ self theClass allSubclasses includes: ea actualClass]]. ^hierarchySenders asArray sort collect: [:ref | OBMessageNode on: aSelector inMethodReference: ref]! ! !OBMethodNode methodsFor: 'navigating' stamp: 'cwp 1/2/2005 23:12'! implementors ^ self implementorsOf: selector! ! !OBMethodNode methodsFor: 'private' stamp: 'lr 4/23/2010 08:36'! implementorsOf: aSelector ^ (SystemNavigation default allImplementorsOf: aSelector) asArray sort collect: [:ref | OBMethodNode on: ref]! ! !OBMethodNode methodsFor: 'private' stamp: 'cwp 12/8/2004 23:49'! inheritanceRoot | rootClass | rootClass := (self theClass withAllSuperclasses asArray select: [:ea | ea includesSelector: self selector]) last. ^ OBCollectionNode on: {OBMethodNode on: self selector inClass: rootClass}! ! !OBMethodNode methodsFor: 'ancestry' stamp: 'cwp 11/28/2004 10:37'! isDescendantOfMethod: other ^ other selector = selector and: [self theClass withAllSuperclasses includes: other theClass]. ! ! !OBMethodNode methodsFor: 'ancestry' stamp: 'dr 11/29/2008 17:26'! isDescendantOfMethodCat: aMethodCatNode ^aMethodCatNode theClass = self theClass and: [(self theClass organization categoryOfElement: self selector) = aMethodCatNode name]! ! !OBMethodNode methodsFor: 'ancestry' stamp: 'cwp 10/17/2004 23:55'! isDescendantOfMethodVersion: anOBMethodVersionNode ^ false! ! !OBMethodNode methodsFor: 'ancestry' stamp: 'lr 5/9/2011 18:23'! isDescendantOfVariable: anVariableNode ^ false! ! !OBMethodNode methodsFor: 'testing' stamp: 'jk 8/25/2007 16:46'! isLocalSelector ^ self theClass localSelectors includes: self selector.! ! !OBMethodNode methodsFor: 'testing' stamp: 'dr 11/2/2006 11:21'! isMethodNode ^true! ! !OBMethodNode methodsFor: 'navigating' stamp: 'lr 8/2/2010 15:59'! messageNode ^ OBMessageNode fromMethodNode: self! ! !OBMethodNode methodsFor: 'private' stamp: 'lr 4/23/2010 08:35'! messageSelectors ^ ((self theClass compiledMethodAt: self selector ifAbsent: [^ #()]) messages) asArray sort! ! !OBMethodNode methodsFor: 'navigating' stamp: 'dc 1/26/2008 11:52'! messages ^ self messageSelectors collect: [:sel | OBMessageNode on: sel inMethod: selector inClass: self theClass]! ! !OBMethodNode methodsFor: 'displaying' stamp: 'cwp 12/8/2004 21:08'! name ^ selector! ! !OBMethodNode methodsFor: 'displaying' stamp: 'jk 5/20/2007 11:01'! nameWithClassNameInBrackets ^ selector, ' (', self theClassName, ')'! ! !OBMethodNode methodsFor: 'navigating' stamp: 'cwp 12/8/2004 23:49'! overrides | classes | classes := OrderedCollection new. self addOverridersOf: self selector inClass: self theClass to: classes. ^ classes collect: [:ea | OBMethodNode on: selector inClass: ea] ! ! !OBMethodNode methodsFor: 'printing' stamp: 'cwp 12/8/2004 21:59'! printOn: aStream aStream nextPutAll: self class name; nextPut: $<; nextPutAll: self theClass name; nextPut: $#; nextPutAll: self selector; nextPut: $>! ! !OBMethodNode methodsFor: 'accessing' stamp: ''! reference ^ self referenceForMethod: selector ofClass: self theClassName! ! !OBMethodNode methodsFor: 'accessing' stamp: 'cwp 12/1/2004 00:37'! selection ^ 1 to: 0! ! !OBMethodNode methodsFor: 'accessing' stamp: ''! selector ^ selector! ! !OBMethodNode methodsFor: 'navigating' stamp: 'lr 8/2/2010 15:59'! selectorAndMessages ^ self messages copyWithFirst: self messageNode! ! !OBMethodNode methodsFor: 'navigating' stamp: ''! senders ^ self sendersOf: selector! ! !OBMethodNode methodsFor: 'private' stamp: 'lr 4/23/2010 08:35'! sendersOf: aSelector ^ (SystemNavigation default allCallsOn: aSelector) asArray sort collect: [:ref | OBMessageNode on: aSelector inMethodReference: ref]! ! !OBMethodNode methodsFor: 'initializing' stamp: ''! setReference: aMethodReference self setSelector: aMethodReference methodSymbol class: (aMethodReference actualClass)! ! !OBMethodNode methodsFor: 'initializing' stamp: ''! setSelector: aSelector class: aClass selector := aSelector. self theClass: aClass ! ! !OBMethodNode methodsFor: 'private' stamp: 'avi 9/17/2005 01:29'! simpleBrowseSenders OBSendersBrowser browseRoot: self! ! !OBMethodNode methodsFor: 'actions' stamp: 'dc 6/27/2007 13:03'! source ^ (self theClass sourceCodeAt: self selector ifAbsent: [^ self defaultSource]) asText makeSelectorBold! ! !OBMethodNode methodsFor: 'accessing' stamp: ''! sourceFiles ^ OBSourceFilesRequest signal! ! !OBMethodNode methodsFor: 'private' stamp: ''! sourcePointer ^ (self theClass compiledMethodAt: self selector) sourcePointer! ! !OBMethodNode methodsFor: 'navigating' stamp: 'lr 3/12/2010 10:23'! versions ^ (OBMethodVersion scan: self sourceFiles from: self sourcePointer) collect: [ :each | OBMethodVersionNode on: each inClass: self theClass ]! ! !OBMethodNode methodsFor: 'private' stamp: 'dc 6/27/2007 13:21'! writeMethodHeaderTo: aStream |keywords| self selector numArgs = 0 ifTrue: [aStream nextPutAll: self selector. ^ self]. keywords := self selector keywords. (1 to: keywords size) do: [:i | aStream nextPutAll: (keywords at: i); space; nextPutAll: 'arg'; print: i ] separatedBy: [aStream space]! ! OBMethodNode subclass: #OBMethodVersionNode instanceVariableNames: 'version' classVariableNames: '' poolDictionaries: '' category: 'OB-Standard-Nodes'! !OBMethodVersionNode commentStamp: 'cwp 1/8/2005 12:41' prior: 0! OBMethodVersions refer to OBMethodVersions, and are used by the VersionBrowser.! !OBMethodVersionNode class methodsFor: 'instance creation' stamp: ''! on: aMethodVersion ^ self new setVersion: aMethodVersion! ! !OBMethodVersionNode class methodsFor: 'instance creation' stamp: 'lr 3/12/2010 10:24'! on: aMethodVersion inClass: aClass ^ self new setVersion: aMethodVersion; theClass: aClass; yourself! ! !OBMethodVersionNode methodsFor: 'actions' stamp: 'lr 10/8/2010 08:44'! browse OBSystemBrowser openOnClass: self theClass selector: version selector! ! !OBMethodVersionNode methodsFor: 'accessing' stamp: 'cwp 10/17/2004 23:57'! category ^ self theClass organization categoryOfElement: version selector! ! !OBMethodVersionNode methodsFor: 'compiling' stamp: 'cwp 10/17/2004 23:53'! definition ^ (OBMethodDefinition source: version source inClass: self theClass) callback: [:sel | version selector = sel ifTrue: [self class on: version latest] ifFalse: [OBMethodNode on: sel inClass: self theClass]]! ! !OBMethodVersionNode methodsFor: 'ancestry' stamp: 'cwp 10/17/2004 23:43'! isDescendantOfMethodVersion: aNode ^ (version = aNode version)! ! !OBMethodVersionNode methodsFor: 'displaying' stamp: 'cwp 11/27/2004 21:38'! name | stamp | stamp := version stamp ifNil: ['']. ^ version theClassName, '>>', version selector, ' ', stamp! ! !OBMethodVersionNode methodsFor: 'accessing' stamp: ''! reference ^ self referenceForMethod: version selector ofClass: self theClassName.! ! !OBMethodVersionNode methodsFor: 'accessing' stamp: 'cwp 10/11/2006 20:55'! selector ^ version selector! ! !OBMethodVersionNode methodsFor: 'initializing' stamp: 'cwp 3/11/2007 21:29'! setVersion: aMethodVersion version := aMethodVersion. self setSelector: version selector class: version theClass! ! !OBMethodVersionNode methodsFor: 'accessing' stamp: 'cwp 10/17/2004 23:44'! version ^ version! ! OBClassAwareNode subclass: #OBVariableNode instanceVariableNames: 'name' classVariableNames: '' poolDictionaries: '' category: 'OB-Standard-Nodes'! !OBVariableNode commentStamp: 'cwp 1/8/2005 12:46' prior: 0! OBVariableNode is an abstract superclass for the two types of variables a class can contain - class variables and instance variables. The only difference between the two subclasses is how they search for methods that refer to them.! OBVariableNode subclass: #OBClassVariableNode instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'OB-Standard-Nodes'! !OBClassVariableNode commentStamp: 'cwp 1/8/2005 12:51' prior: 0! OBClassVariable provides a method for finding methods which refer to a shared variable, ie, by searching for an association in the literal frame rather than for bytecodes refering to an instance variable.! !OBClassVariableNode methodsFor: 'navigating' stamp: 'lr 7/3/2009 21:42'! accessors | literal | literal := self theClass bindingOf: name. ^ ((self systemNavigation allCallsOn: literal) asArray sort) collect: [:ref | OBMethodNode on: ref]! ! OBVariableNode subclass: #OBInstanceVariableNode instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'OB-Standard-Nodes'! !OBInstanceVariableNode commentStamp: 'cwp 1/8/2005 12:50' prior: 0! OBClassVariable provides a method for finding methods which refer to an instance, ie, by searching for instance variable access bytecodes rather than for an association in the literal frame.! !OBInstanceVariableNode methodsFor: 'navigating' stamp: 'cwp 12/8/2004 23:48'! accessors | accessors | accessors := OrderedCollection new. self theClass withAllSubAndSuperclassesDo: [:class | (class whichSelectorsAccess: name) asSortedCollection do: [:ea | ea = #DoIt ifFalse: [accessors add: (self referenceForMethod: ea ofClass: class name)]]]. ^ accessors asArray collect: [:ref | OBMethodNode on: ref]! ! !OBVariableNode class methodsFor: 'instance creation' stamp: ''! on: instVarName inClass: aClassReference ^ self new setName: instVarName class: aClassReference! ! !OBVariableNode methodsFor: 'comparing' stamp: 'lr 4/9/2011 17:33'! = aNode ^ super = aNode and: [ self name = aNode name ]! ! !OBVariableNode methodsFor: 'navigating' stamp: 'PDC 6/25/2007 23:01'! accessors self subclassResponsibility ! ! !OBVariableNode methodsFor: 'ancestry' stamp: 'lr 4/9/2011 18:09'! ancestrySelector ^ #isDescendantOfVariable: ! ! !OBVariableNode methodsFor: 'comparing' stamp: 'lr 4/9/2011 17:33'! hash ^ super hash bitXor: self name hash! ! !OBVariableNode methodsFor: 'ancestry' stamp: 'lr 4/9/2011 18:13'! isDescendantOfVariable: aNode ^ self name = aNode name and: [ self theClass withAllSuperclasses includes: aNode theClass ]! ! !OBVariableNode methodsFor: 'displaying' stamp: ''! name ^ name! ! !OBVariableNode methodsFor: 'initializing' stamp: ''! setName: aString class: aClass name := aString. self theClass: aClass! ! OBCodeNode subclass: #OBClassCategoryNode instanceVariableNames: 'environment name' classVariableNames: '' poolDictionaries: '' category: 'OB-Standard-Nodes'! !OBClassCategoryNode commentStamp: 'cwp 1/8/2005 12:58' prior: 0! OBClassCategory represents a system category in the image's SystemOrganization.! !OBClassCategoryNode class methodsFor: 'instance creation' stamp: ''! on: aString ^ self new setName: aString! ! !OBClassCategoryNode class methodsFor: 'instance creation' stamp: ''! on: aString inEnvironment: anEnvironment ^ self new setName: aString environment: anEnvironment! ! !OBClassCategoryNode methodsFor: 'ancestry' stamp: ''! ancestrySelector ^ #isDescendantOfClassCat:! ! !OBClassCategoryNode methodsFor: 'actions' stamp: 'lr 10/8/2010 08:44'! browse OBSystemBrowser openOnEnvironment: environment category: name! ! !OBClassCategoryNode methodsFor: 'private' stamp: ''! classNames ^ environment organization listAtCategoryNamed: name! ! !OBClassCategoryNode methodsFor: 'navigating' stamp: 'dvf 8/15/2005 17:31'! classes ^ self classNames collect: [:ea | (environment at: ea) asNode]! ! !OBClassCategoryNode methodsFor: 'navigating' stamp: 'dvf 8/17/2005 17:25'! comments ^ self classNames collect: [:ea | (environment at: ea) asCommentNode ]! ! !OBClassCategoryNode methodsFor: 'accessing' stamp: 'cwp 9/22/2004 22:13'! container ^ environment! ! !OBClassCategoryNode methodsFor: 'displaying' stamp: ''! definition ^ OBClassDefinition environment: environment template: ((environment at: #Class) template: name)! ! !OBClassCategoryNode methodsFor: 'drag and drop' stamp: 'lr 4/7/2010 18:48'! dropOnClassCategory: aClassCategory | categories index | categories := environment organization categories copyWithout: self name. index := categories indexOf: aClassCategory name ifAbsent: [ ^ false ]. categories := (categories copyFrom: 1 to: index) , (Array with: self name) , (categories copyFrom: index + 1 to: categories size). environment organization categories: categories. self signalSelection. ^ true! ! !OBClassCategoryNode methodsFor: 'drag and drop' stamp: ''! dropSelector ^ #dropOnClassCategory:! ! !OBClassCategoryNode methodsFor: 'services' stamp: ''! fileOut environment organization fileOutCategory: name.! ! !OBClassCategoryNode methodsFor: 'testing' stamp: 'lr 3/13/2010 12:10'! isBrowsable ^ true! ! !OBClassCategoryNode methodsFor: 'testing' stamp: 'dr 10/30/2008 09:54'! isCategoryNode ^ true! ! !OBClassCategoryNode methodsFor: 'ancestry' stamp: ''! isDescendantOfClassCat: other ^ other name = name! ! !OBClassCategoryNode methodsFor: 'navigating' stamp: 'dvf 8/15/2005 17:52'! metaclasses ^self classNames collect: [:ea | (environment at: ea) asClassSideNode]! ! !OBClassCategoryNode methodsFor: 'displaying' stamp: 'dr 12/9/2008 20:17'! name ^name! ! !OBClassCategoryNode methodsFor: 'printing' stamp: 'cwp 5/11/2007 00:59'! printOn: aStream aStream nextPutAll: self class name; nextPut: $<; nextPutAll: self name; nextPut: $>! ! !OBClassCategoryNode methodsFor: 'actions' stamp: 'lr 11/25/2010 23:49'! remove environment organization removeSystemCategory: name! ! !OBClassCategoryNode methodsFor: 'actions' stamp: 'cwp 6/11/2009 16:59'! renameTo: aString self container organization renameCategory: self name toBe: aString. ! ! !OBClassCategoryNode methodsFor: 'initializing' stamp: ''! setName: aString self setName: aString environment: self class environment! ! !OBClassCategoryNode methodsFor: 'initializing' stamp: ''! setName: aString environment: anEnvironment name := aString asSymbol. environment := anEnvironment! ! !OBClassCategoryNode methodsFor: 'displaying' stamp: ''! text ^ 'Object subclass: #NameOfSubclass instanceVariableNames: '''' classVariableNames: '''' poolDictionaries: '''' category: ''', self name, ''''! ! !OBCodeNode class methodsFor: 'instance creation' stamp: 'PDC 6/26/2007 21:40'! on: anObject self subclassResponsibility ! ! !OBCodeNode methodsFor: 'testing' stamp: 'cwp 6/30/2006 00:37'! hasOrganization ^ false! ! !OBCodeNode methodsFor: 'testing' stamp: 'cwp 10/11/2006 20:47'! hasSelector ^ false! ! !OBCodeNode methodsFor: 'testing' stamp: 'cwp 10/9/2006 18:12'! hasVersions ^ false! ! !OBCodeNode methodsFor: 'testing' stamp: 'cwp 8/20/2009 22:39'! isCategoryNode ^ false! ! !OBCodeNode methodsFor: 'testing' stamp: 'cwp 8/21/2009 11:23'! isClassNode ^ false! ! !OBCodeNode methodsFor: 'testing' stamp: 'cwp 8/21/2009 11:23'! isEnvironmentNode ^ false! ! !OBCodeNode methodsFor: 'testing' stamp: 'cwp 8/22/2009 11:17'! isMethodCategoryNode ^ false! ! !OBCodeNode methodsFor: 'testing' stamp: 'cwp 8/22/2009 11:18'! isMethodNode ^ false! ! !OBCodeNode methodsFor: 'utility' stamp: 'lr 10/27/2010 20:58'! referenceForMethod: selector ofClass: className | classIsMeta symbol | classIsMeta := className endsWith: ' class'. symbol := classIsMeta ifTrue: [ (className allButLast: 6) asSymbol ] ifFalse: [ className ]. ^ MethodReference new setClassSymbol: symbol classIsMeta: classIsMeta methodSymbol: selector stringVersion: symbol , '>>' , selector! ! OBCodeNode subclass: #OBEnvironmentNode instanceVariableNames: 'environment' classVariableNames: '' poolDictionaries: '' category: 'OB-Standard-Nodes'! !OBEnvironmentNode commentStamp: 'cwp 1/8/2005 13:01' prior: 0! OBEnvironmentNode wraps an instance of SystemDictionary. In current Squeak images, there is only one such instance, but OB-Standard is coded so as to use rely on this assumption as little as possible. Thus OBEnvironmentNode typically serves as the root of the standard browser, and passes its environment on to other nodes in the tree.! !OBEnvironmentNode class methodsFor: 'instance creation' stamp: ''! forImage ^ self on: Smalltalk! ! !OBEnvironmentNode class methodsFor: 'instance creation' stamp: ''! on: anEnvironment ^ self new setEnvironment: anEnvironment! ! !OBEnvironmentNode methodsFor: 'navigating' stamp: ''! categories ^ environment organization categories collect: [:cat | OBClassCategoryNode on: cat inEnvironment: environment]! ! !OBEnvironmentNode methodsFor: 'navigating' stamp: 'cwp 9/20/2005 08:43'! categoryNodeNamed: aString ^ OBClassCategoryNode on: aString! ! !OBEnvironmentNode methodsFor: 'accessing' stamp: ''! environment ^ environment! ! !OBEnvironmentNode methodsFor: 'testing' stamp: 'cwp 6/30/2006 00:54'! hasOrganization ^ true! ! !OBEnvironmentNode methodsFor: 'testing' stamp: 'cwp 8/21/2009 11:23'! isEnvironmentNode ^ true! ! !OBEnvironmentNode methodsFor: 'displaying' stamp: 'lr 2/9/2008 12:00'! name ^ environment name! ! !OBEnvironmentNode methodsFor: 'accessing' stamp: ''! organization ^ self environment organization! ! !OBEnvironmentNode methodsFor: 'initializing' stamp: ''! setEnvironment: anEnvironment environment := anEnvironment! ! OBCodeNode subclass: #OBSearchNode instanceVariableNames: 'query' classVariableNames: '' poolDictionaries: '' category: 'OB-Standard-Nodes'! OBSearchNode subclass: #OBClassRefSearchNode instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'OB-Standard-Nodes'! !OBClassRefSearchNode methodsFor: 'private' stamp: 'cwp 4/15/2007 21:27'! classSatisfiesQuery: aClass ^ (SystemNavigation default allCallsOn: (Smalltalk associationAt: query) from: aClass) isEmpty not! ! !OBClassRefSearchNode methodsFor: 'navigation' stamp: 'dr 2/18/2009 16:13'! classes | refs classNames nodes | refs := SystemNavigation default allCallsOn: (Smalltalk associationAt: query ifAbsent: [^#()]). classNames := refs collect: [:ea | ea classSymbol]. nodes := classNames asSet collect: [:ea | OBClassNode on: (Smalltalk at: ea)]. ^ nodes asArray sort: [:a :b | a theClassName <= b theClassName]! ! !OBClassRefSearchNode methodsFor: 'display' stamp: 'cwp 7/20/2007 22:23'! name ^ (super name copyWithFirst: $#) , ' (class refs)'! ! OBSearchNode subclass: #OBClassSearchNode instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'OB-Standard-Nodes'! !OBClassSearchNode methodsFor: 'private' stamp: 'cwp 6/11/2009 12:45'! classSatisfiesQuery: aClass | classQueried | classQueried := aClass name. query do: [:aQuery | (classQueried includesSubstring: aQuery caseSensitive: false) ifTrue: [classQueried := classQueried copyFrom: (classQueried indexOfSubCollection: aQuery) + aQuery size to: classQueried size] ifFalse:[^false]]. ^true! ! !OBClassSearchNode methodsFor: 'navigation' stamp: 'lr 11/13/2008 13:44'! classes ^ ((SystemNavigation default allClasses select: [ :ea | self classSatisfiesQuery: ea ]) collect: [ :ea | OBClassNode on: ea ]) asArray! ! !OBClassSearchNode methodsFor: 'display' stamp: 'cb 7/19/2007 13:52'! name |name| name := '*'. query do: [:ea | name := name , ea, '*']. ^name, ' (classes)'! ! OBSearchNode subclass: #OBImplementorSearchNode instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'OB-Standard-Nodes'! !OBImplementorSearchNode methodsFor: 'private' stamp: 'cwp 4/15/2007 20:40'! classSatisfiesQuery: aClass ^ aClass includesSelector: query! ! !OBImplementorSearchNode methodsFor: 'navigation' stamp: 'dr 10/22/2008 09:44'! classes ^ (SystemNavigation default allClassesImplementing: query) collect: [:ea | OBClassNode on: ea]! ! !OBImplementorSearchNode methodsFor: 'display' stamp: 'dr 10/22/2008 09:15'! name ^super name, ' (implementors)' ! ! OBSearchNode subclass: #OBMethodSearchNode instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'OB-Standard-Nodes'! !OBMethodSearchNode methodsFor: 'private' stamp: 'dr 10/22/2008 09:54'! classSatisfiesQuery: aClass ^ aClass selectors anySatisfy: [:ea | ea includesSubstring: query caseSensitive: true]! ! !OBMethodSearchNode methodsFor: 'navigation' stamp: 'dr 10/22/2008 09:38'! classes | nav classes | nav := self systemNavigation. classes := IdentitySet new. (Symbol selectorsContaining: query) do: [:ea | classes addAll: (nav allClassesImplementing: ea)]. ^ classes asArray collect: [:ea | OBClassNode on: ea]! ! !OBMethodSearchNode methodsFor: 'display' stamp: 'cb 7/19/2007 21:18'! name ^ super name, '* (implementors)'! ! !OBSearchNode class methodsFor: 'instance creation' stamp: 'dr 10/22/2008 09:38'! on: aString ^ self basicNew setRawQuery: aString! ! !OBSearchNode methodsFor: 'comparing' stamp: 'cwp 4/19/2007 00:36'! = other ^ self species = other species and: [self query = other query]! ! !OBSearchNode methodsFor: 'private' stamp: 'PDC 6/25/2007 21:23'! classSatisfiesQuery: aClass self subclassResponsibility ! ! !OBSearchNode methodsFor: 'navigation' stamp: 'PDC 6/25/2007 21:19'! classes self subclassResponsibility ! ! !OBSearchNode methodsFor: 'navigation' stamp: 'PDC 6/25/2007 21:16'! comments ^self classes collect: [:ea| ea theClass asCommentNode]! ! !OBSearchNode methodsFor: 'displaying' stamp: 'dr 10/20/2008 16:17'! displayString ^ self name.! ! !OBSearchNode methodsFor: 'comparing' stamp: 'cwp 4/19/2007 00:36'! hash ^ query hash! ! !OBSearchNode methodsFor: 'ancestry' stamp: 'cwp 4/15/2007 20:31'! isAncestorOf: aNode ^ self = aNode or: [self classSatisfiesQuery: aNode theClass]! ! !OBSearchNode methodsFor: 'ancestry' stamp: 'cwp 5/12/2007 23:12'! isAncestorOf: aNode using: aSelector ^ self = aNode or: [self classSatisfiesQuery: aNode theClass]! ! !OBSearchNode methodsFor: 'navigation' stamp: 'PDC 6/25/2007 21:17'! metaclasses ^self classes collect: [:ea| ea theMetaClass asClassSideNode]! ! !OBSearchNode methodsFor: 'display' stamp: 'cwp 4/7/2007 23:28'! name ^ query! ! !OBSearchNode methodsFor: 'private' stamp: 'cwp 4/15/2007 20:14'! nodesForRefs: refs | classNames nodes | classNames := refs collect: [:ea | ea classSymbol]. nodes := classNames asSet collect: [:ea | OBClassNode on: (Smalltalk at: ea)]. ^ nodes asArray sort: [:a :b | a theClassName <= b theClassName]! ! !OBSearchNode methodsFor: 'accessing' stamp: 'cwp 4/8/2007 00:26'! query ^ query! ! !OBSearchNode methodsFor: 'initialize-release' stamp: 'PDC 6/29/2007 06:37'! setRawQuery: aString query := aString! ! OBSearchNode subclass: #OBSenderSearchNode instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'OB-Standard-Nodes'! !OBSenderSearchNode methodsFor: 'private' stamp: 'cwp 4/15/2007 21:27'! classSatisfiesQuery: aClass ^ (SystemNavigation default allCallsOn: query from: aClass) isEmpty not! ! !OBSenderSearchNode methodsFor: 'navigation' stamp: 'cwp 4/15/2007 21:32'! classes ^ self nodesForRefs: (SystemNavigation default allCallsOn: query) ! ! !OBSenderSearchNode methodsFor: 'display' stamp: 'cb 7/17/2007 11:53'! name ^ (super name copyWithFirst: $#) , ' (senders)'! ! OBCodeNode subclass: #OBSelectorNode instanceVariableNames: 'selector methods' classVariableNames: '' poolDictionaries: '' category: 'OB-Standard-Nodes'! !OBSelectorNode commentStamp: 'cwp 1/8/2005 13:03' prior: 0! OBSelectorNode wraps an instance of Symbol. It typically serves as the root of a senders or implementors OBListBrowser, and is used when cmd-n or cmd-m is invoke from the definition panel, and so no OBMethodNode is available.! !OBSelectorNode class methodsFor: 'instance creation' stamp: 'cwp 10/31/2004 01:11'! on: aSelector ^ self new selector: aSelector! ! !OBSelectorNode methodsFor: 'testing' stamp: 'cwp 10/11/2006 20:56'! hasSelector ^ true! ! !OBSelectorNode methodsFor: 'navigating' stamp: 'lr 5/7/2011 14:15'! implementors ^ (SystemNavigation default allImplementorsOf: self selector) asArray sort collect: [ :ref | OBMethodNode on: ref ]! ! !OBSelectorNode methodsFor: 'ancestry' stamp: 'lr 2/7/2010 10:50'! isAncestorOf: aNode ^ (aNode source findString: selector string startingAt: 0 ) isZero not! ! !OBSelectorNode methodsFor: 'navigating' stamp: 'lr 7/6/2010 22:13'! methods methods ifNil: [ methods := SystemNavigation default selectAllMethods: [ :method | method hasLiteralSuchThat: [ :literal | literal isString and: [ literal isSymbol not and: [ literal includesSubstring: selector string caseSensitive: false ] ] ] ] ]. ^ methods collect: [ :method | OBMethodNode on: method ]! ! !OBSelectorNode methodsFor: 'navigating' stamp: 'cwp 10/31/2004 01:12'! name ^ selector printString! ! !OBSelectorNode methodsFor: 'accessing' stamp: 'dr 7/18/2007 13:57'! reference | references | "this is a bit hacky actually..." references := SystemNavigation default allImplementorsOf: selector. references ifEmpty: [self error: 'No method with this selector exists!!']. ^references first! ! !OBSelectorNode methodsFor: 'accessing' stamp: 'cwp 10/31/2004 01:11'! selector ^ selector! ! !OBSelectorNode methodsFor: 'accessing' stamp: 'cwp 10/31/2004 01:10'! selector: aSelector selector := aSelector! ! !OBSelectorNode methodsFor: 'navigating' stamp: 'lr 8/2/2010 16:23'! selectorAndMessages ^ Array with: self! ! !OBSelectorNode methodsFor: 'navigating' stamp: 'lr 5/7/2011 14:14'! senders ^ (SystemNavigation default allCallsOn: self selector) asArray sort collect: [ :ref | OBMessageNode on: self selector inMethodReference: ref ]! ! !OBSelectorNode methodsFor: 'navigating' stamp: 'lr 8/2/2010 16:25'! unifySelectors! ! !OBNode methodsFor: '*ob-standard' stamp: 'lr 3/13/2010 11:56'! annotationString "Provide a line of content for an annotation pane, representing information about the method associated with the selected node." ^ nil! ! !OBNode methodsFor: '*ob-standard' stamp: 'lr 3/13/2010 12:08'! isBrowsable ^ false! ! Notification subclass: #OBSourceFilesRequest instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'OB-Standard-Utilities'! !OBSourceFilesRequest commentStamp: 'cwp 1/8/2005 13:09' prior: 0! OBSourceFilesRequest is used to work around the fact that Squeak's source files are stored in a global array called SourceFiles. When testing OBMethodVersion and OBVersionBrowser, we don't want to use the real source files, as they are too unpredictable. Instead the test cases supply a source file array with known contents. Therefore, OBMethodVersion never refers directly to the SourceFiles global. Instead it raises an OBSourceFiles request. If this occurs during a test, the test catches the notification and resumes using the test source files. Otherwise, the default action resumes using the global source file array.! !OBSourceFilesRequest methodsFor: 'exceptionDescription' stamp: ''! defaultAction ^ SourceFiles! ! !OBSourceFilesRequest methodsFor: 'exceptionDescription' stamp: 'cwp 11/27/2004 22:49'! isBrowseRequest ^ false! ! !MethodReference methodsFor: '*ob-standard' stamp: 'lr 2/12/2009 10:40'! asNode ^ OBMethodNode on: self! ! OBDefinition subclass: #OBClassCommentDefinition instanceVariableNames: 'theClass' classVariableNames: '' poolDictionaries: '' category: 'OB-Standard-Definitions'! !OBClassCommentDefinition class methodsFor: 'instance creation' stamp: 'cwp 8/7/2007 00:09'! on: aClass ^ self new setClass: aClass! ! !OBClassCommentDefinition methodsFor: 'accessing' stamp: 'dc 10/6/2007 15:26'! selectedClass ^ theClass ! ! !OBClassCommentDefinition methodsFor: 'accessing' stamp: 'lr 5/29/2010 08:51'! setClass: aClass theClass := aClass theNonMetaClass! ! !OBClassCommentDefinition methodsFor: 'accessing' stamp: 'lr 5/29/2010 08:53'! template ^ theClass classCommentBlank! ! !OBClassCommentDefinition methodsFor: 'callbacks' stamp: 'lr 5/29/2010 08:53'! text | comment | comment := theClass organization classComment. ^ comment isEmpty ifTrue: [ self template ] ifFalse: [ comment ]! ! !OBClassCommentDefinition methodsFor: 'callbacks' stamp: 'lr 9/26/2010 18:14'! text: aText theClass comment: aText asString stamp: OBBrowserPlatform changeStamp. ^ true! ! OBDefinition subclass: #OBClassDefinition instanceVariableNames: 'environment template' classVariableNames: '' poolDictionaries: '' category: 'OB-Standard-Definitions'! !OBClassDefinition commentStamp: 'cwp 1/8/2005 13:13' prior: 0! OBClassDefinition presents a textual interface for examining, modifying and creating classes. Given a class, it knows how to display the definition expression that reflects it's current state, and knows how to create or modify a class given a definition expression. OBClassDefinition implements a number of safety checks when defining or redefining classes, to ensure that existing classes are not accidentally overwritten.! !OBClassDefinition class methodsFor: 'instance creation' stamp: ''! environment: anEnvironment template: aString ^ self new setEnvironment: anEnvironment template: aString! ! !OBClassDefinition methodsFor: 'callbacks' stamp: ''! accept: aText notifying: aController ^ self defineClass: aText notifying: aController! ! !OBClassDefinition methodsFor: 'confirmation' stamp: ''! confirmDefinition: definition "Check to make sure the user isn't accidentally over-writing an existing class." (((self isRedefinition: definition) not) and: [self definedClassExists: definition]) ifTrue: [^ self confirmRedefinition: definition] ifFalse: [^ true]! ! !OBClassDefinition methodsFor: 'confirmation' stamp: 'lr 11/26/2010 00:01'! confirmRedefinition: definition | newName answer | newName := self nameOfClassDefinedBy: definition. answer := OBConfirmationRequest prompt: newName , ' is an existing class in this system. Redefining it might cause serious problems. Is this really what you want to do?' confirm: 'Redefine'. ^ answer ifNil: [false]! ! !OBClassDefinition methodsFor: 'class definition' stamp: ''! defineClass: definition notifying: aController | evaluator newClass | (self confirmDefinition: definition) ifFalse: [^ false]. evaluator := self evaluatorForDefinition: definition. newClass := evaluator evaluate: definition notifying: aController logged: true. newClass ifNil: [^ false]. self signalSelectionOf: newClass. ^ true ! ! !OBClassDefinition methodsFor: 'confirmation' stamp: ''! definedClassExists: definition ^ environment hasClassNamed: (self nameOfClassDefinedBy: definition)! ! !OBClassDefinition methodsFor: 'class definition' stamp: ''! evaluatorForDefinition: definition | tokens | tokens := Scanner new scanTokens: definition. ^ (environment at: tokens first ifAbsent: [nil]) subclassDefinerClass! ! !OBClassDefinition methodsFor: 'confirmation' stamp: ''! isRedefinition: aDefinition ^ (self nameOfClassDefinedBy: aDefinition) = (self nameOfClassDefinedBy: template)! ! !OBClassDefinition methodsFor: 'confirmation' stamp: ''! nameOfClassDefinedBy: definition ^ (Scanner new scanTokens: definition) third! ! !OBClassDefinition methodsFor: 'confirmation' stamp: 'lr 11/22/2010 22:53'! nameOfMetaclassDefinedBy: definition ^ (Scanner new scanTokens: definition) first! ! !OBClassDefinition methodsFor: 'confirmation' stamp: 'lr 11/22/2010 22:53'! selectedClass ^ environment at: (self nameOfClassDefinedBy: template) ifAbsent: [ environment at: (self nameOfMetaclassDefinedBy: template) ifAbsent: [ nil ] ]! ! !OBClassDefinition methodsFor: 'initializing' stamp: ''! setEnvironment: anEnvironment template: aText environment := anEnvironment. template := aText.! ! !OBClassDefinition methodsFor: 'class definition' stamp: 'lr 11/25/2010 23:43'! signalSelectionOf: aClass aClass asNode signalCreation! ! !OBClassDefinition methodsFor: 'callbacks' stamp: ''! text ^ template! ! OBDefinition subclass: #OBMethodDefinition instanceVariableNames: 'theClass category source selection callback compileClass compileCategory compileText' classVariableNames: '' poolDictionaries: '' category: 'OB-Standard-Definitions'! !OBMethodDefinition commentStamp: 'cwp 1/8/2005 13:20' prior: 0! OBMethodDefinition knows how to present method source in the browser's text pane and compile a new CompiledMethod when the source changes. It implements several safety checks to ensure that methods are not accidentally overwritten.! !OBMethodDefinition class methodsFor: 'instance creation' stamp: 'cwp 10/17/2004 23:07'! inCategory: aString inClass: aClass ^ self selection: nil source: nil inCategory: aString inClass: aClass! ! !OBMethodDefinition class methodsFor: 'instance creation' stamp: 'cwp 10/17/2004 23:07'! selection: anInterval source: aText inCategory: aCategory inClass: aClass ^ self new setClass: aClass category: aCategory source: aText selection: anInterval! ! !OBMethodDefinition class methodsFor: 'instance creation' stamp: 'cwp 10/17/2004 23:07'! selection: anInterval source: aText inClass: aClass ^ self selection: anInterval source: aText inCategory: nil inClass: aClass ! ! !OBMethodDefinition class methodsFor: 'instance creation' stamp: 'cwp 10/17/2004 23:03'! source: aText inClass: aClass ^ self selection: nil source: aText inCategory: nil inClass: aClass! ! !OBMethodDefinition methodsFor: 'callbacks' stamp: 'cwp 12/8/2011 18:01'! accept: aText notifying: aController | newSelector node | newSelector := [ self compileMethod: aText notifying: aController ] on: ParserNotification do: [ :notification | self parserNotification: notification. ^ false ]. newSelector ifNil: [ ^ false ]. node := self nodeFor: newSelector. self selector = newSelector ifTrue: [node signalChanged] ifFalse: [node signalCreation]. ^ true! ! !OBMethodDefinition methodsFor: 'accessing' stamp: 'cwp 10/17/2004 23:36'! callback: aBlockContext callback := aBlockContext! ! !OBMethodDefinition methodsFor: 'accessing' stamp: ''! category ^ category ifNil: [category := self theClass whichCategoryIncludesSelector: self selector]! ! !OBMethodDefinition methodsFor: 'accessing' stamp: 'jk 8/22/2007 20:09'! compileCategory ^ compileCategory! ! !OBMethodDefinition methodsFor: 'accessing' stamp: 'jk 8/22/2007 20:09'! compileCategory: anObject compileCategory := anObject! ! !OBMethodDefinition methodsFor: 'accessing' stamp: 'jk 8/22/2007 18:36'! compileClass ^ compileClass! ! !OBMethodDefinition methodsFor: 'accessing' stamp: 'jk 8/22/2007 18:36'! compileClass: anObject compileClass := anObject! ! !OBMethodDefinition methodsFor: 'compiling' stamp: 'lr 7/3/2009 21:49'! compileMethod: aText notifying: aController self compileClass: self theClass. self compileCategory: self category. self compileText: aText. ^ self compileNotifying: aController! ! !OBMethodDefinition methodsFor: 'compiling' stamp: 'lr 3/4/2009 22:16'! compileNotifying: aController ^ self compileClass compile: self compileText classified: self compileCategory notifying: aController! ! !OBMethodDefinition methodsFor: 'accessing' stamp: 'jk 8/22/2007 18:37'! compileText ^ compileText! ! !OBMethodDefinition methodsFor: 'accessing' stamp: 'jk 8/22/2007 18:37'! compileText: anObject compileText := anObject! ! !OBMethodDefinition methodsFor: 'compiling' stamp: 'cwp 10/17/2004 23:33'! nodeFor: aSelector ^ callback value: aSelector! ! !OBMethodDefinition methodsFor: 'callbacks' stamp: 'lr 10/20/2011 18:36'! parserNotification: aNotification aNotification handleWith: self! ! !OBMethodDefinition methodsFor: 'callbacks' stamp: ''! selectedClass ^ self theClass! ! !OBMethodDefinition methodsFor: 'callbacks' stamp: 'lr 3/4/2009 08:20'! selection ^ selection ifNil: [ 1 to: (source isNil ifTrue: [ self text size ] ifFalse: [ 0 ]) ]! ! !OBMethodDefinition methodsFor: 'accessing' stamp: 'lr 3/4/2009 08:17'! selector ^ source isNil ifFalse: [ Parser new parseSelector: source ]! ! !OBMethodDefinition methodsFor: 'initializing' stamp: 'cwp 10/17/2004 23:33'! setClass: aClass category: aString source: aText selection: anInterval theClass := aClass. category := aString. source := aText. selection := anInterval. callback := [:sel | OBMethodNode on: sel inClass: theClass]! ! !OBMethodDefinition methodsFor: 'callbacks' stamp: 'lr 3/4/2009 08:18'! text ^ source isNil ifFalse: [ source asText makeSelectorBold ] ifTrue: [ self theClass sourceCodeTemplate ]! ! !OBMethodDefinition methodsFor: 'accessing' stamp: ''! theClass ^ theClass! ! OBDefinition subclass: #OBOrganizationDefinition instanceVariableNames: 'organizer' classVariableNames: '' poolDictionaries: '' category: 'OB-Standard-Definitions'! !OBOrganizationDefinition commentStamp: 'cwp 1/8/2005 13:31' prior: 0! OBOrganizationDefinition knows how to display and edit the organization of classes or methods by a Categorizer.! !OBOrganizationDefinition class methodsFor: 'instance creation' stamp: 'cwp 9/22/2004 21:20'! on: anOrganizer ^ self new organizer: anOrganizer! ! !OBOrganizationDefinition methodsFor: 'accessing' stamp: 'cwp 9/22/2004 21:21'! organizer: anOrganizer organizer := anOrganizer! ! !OBOrganizationDefinition methodsFor: 'callbacks' stamp: 'cwp 9/22/2004 21:18'! text ^ organizer asString! ! !OBOrganizationDefinition methodsFor: 'callbacks' stamp: 'lr 12/3/2010 10:24'! text: aText organizer changeFromString: aText asString. OBAnnouncer current announce: OBRefreshRequired. ^ true! ! !Metaclass methodsFor: '*ob-standard-converting' stamp: 'lr 8/4/2007 10:34'! asClassSideNode ^ OBMetaclassNode on: self! ! !Metaclass methodsFor: '*ob-standard-converting' stamp: 'lr 8/4/2007 10:33'! asNode ^ OBMetaclassNode on: self! ! !OBCollectionNode methodsFor: '*ob-standard-testing' stamp: 'cb 7/18/2007 11:46'! hasOrganization ^ false! ! !OBCollectionNode methodsFor: '*ob-standard-testing' stamp: 'cwp 4/1/2007 22:59'! hasSelector ^ false! ! !OBCollectionNode methodsFor: '*ob-standard-testing' stamp: 'cwp 4/1/2007 23:00'! hasVersions ^ false! ! !OBCollectionNode methodsFor: '*ob-standard-testing' stamp: 'cwp 8/22/2009 11:19'! isCategoryNode ^ false! ! !OBCollectionNode methodsFor: '*ob-standard-testing' stamp: 'cwp 8/22/2009 11:18'! isEnvironmentNode ^ false! ! !ClassTrait methodsFor: '*ob-standard-converting' stamp: 'lr 2/19/2009 15:28'! asClassSideNode ^ OBMetaclassNode on: self! ! !ClassTrait methodsFor: '*ob-standard-converting' stamp: 'lr 2/19/2009 15:28'! asNode ^ OBMetaclassNode on: self! ! !UnusedVariable methodsFor: '*ob-standard-handling' stamp: 'lr 10/20/2011 18:30'! handleWith: aMethodDefinition self resume: (OBConfirmationRequest prompt: name printString , ' appears to be unused in this method. Should it be removed?' confirm: 'Yes' cancel: 'No')! ! !ParseNode methodsFor: '*ob-standard' stamp: 'cwp 7/18/2007 19:31'! selectorIs: aSymbol ^ false! ! !UnknownSelector methodsFor: '*ob-standard-handling' stamp: 'lr 10/20/2011 18:36'! handleWith: aMethodDefinition | response | response := OBCmdBrowseList selectSymbol: 'Unknown selector: #' , name asString default: name proposed: (Symbol possibleSelectorsFor: name) assisted: true. self resume: (response isNil ifFalse: [ response asSymbol ])! ! !Exception class methodsFor: '*ob-standard' stamp: 'lr 3/28/2009 15:56'! browserIcon ^ #exception! ! !MessageNode methodsFor: '*ob-standard' stamp: 'lr 2/12/2009 10:41'! selectorIs: aSymbol aSymbol isNil ifTrue: [ ^ false ]. ((selector isKindOf: SelectorNode) or: [ selector isKindOf: Association ]) ifTrue: [ ^ selector key == aSymbol ]. selector isSymbol ifTrue: [ ^ selector == aSymbol ]. ^ false! ! OBBrowser subclass: #OBCodeBrowser instanceVariableNames: 'hasChanges' classVariableNames: 'ChasingBrowsersEnabled MercuryPanelEnabled' poolDictionaries: '' category: 'OB-Standard-Browsers'! !OBCodeBrowser commentStamp: 'cwp 1/7/2005 23:45' prior: 0! OBCodeBrowser is a superclass for all browsers which active code in the image. It provides methods for registering with the SystemChangeNotifier and updating it's display when it receives notification of system changes.! !OBCodeBrowser class methodsFor: 'configuration' stamp: 'cwp 11/3/2011 16:55'! annotationPanel ^ OBPlatform current showAnnotationPane ifTrue: [ OBAnnotationPanel new ]! ! !OBCodeBrowser class methodsFor: 'configuration' stamp: 'cwp 5/20/2007 00:02'! buildMetagraphOn: root ^ self buildMetagraphOn: root class: #classes comment: #comments metaclass: #metaclasses! ! !OBCodeBrowser class methodsFor: 'configuration' stamp: 'PDC 6/27/2007 08:21'! buildMetagraphOn: root class: classSel comment: commentSel metaclass: metaclassSel ^ (OBMetagraphBuilder on: root class: classSel comment: commentSel metaclass: metaclassSel) execute! ! !OBCodeBrowser class methodsFor: 'accessing' stamp: 'lr 8/15/2010 15:28'! chasingBrowsersEnabled ^ ChasingBrowsersEnabled! ! !OBCodeBrowser class methodsFor: 'accessing' stamp: 'lr 8/15/2010 15:29'! chasingBrowsersEnabled: aBoolean ChasingBrowsersEnabled := aBoolean! ! !OBCodeBrowser class methodsFor: 'configuration' stamp: 'PDC 6/27/2007 23:02'! defaultRootNode ^nil! ! !OBCodeBrowser class methodsFor: 'initialization' stamp: 'lr 8/15/2010 15:31'! initialize self mercuryPanelEnabled: false. self chasingBrowsersEnabled: true! ! !OBCodeBrowser class methodsFor: 'configuration' stamp: 'lr 8/15/2010 15:20'! mercuryPanel ^ self mercuryPanelEnabled ifTrue: [ OBMercuryPanel new ]! ! !OBCodeBrowser class methodsFor: 'accessing' stamp: 'lr 8/15/2010 15:19'! mercuryPanelEnabled ^ MercuryPanelEnabled! ! !OBCodeBrowser class methodsFor: 'accessing' stamp: 'lr 8/15/2010 15:19'! mercuryPanelEnabled: aBoolean MercuryPanelEnabled := aBoolean! ! !OBCodeBrowser class methodsFor: 'configuration' stamp: 'lr 8/15/2010 15:40'! panels ^ Array with: self mercuryPanel with: self navigationPanel with: self annotationPanel with: self buttonPanel with: self definitionPanel! ! !OBCodeBrowser class methodsFor: 'configuration' stamp: 'lr 8/15/2010 15:30'! settingsOn: aBuilder (aBuilder group: #OmniBrowser) parentName: #codeBrowsing; with: [ (aBuilder setting: #mercuryPanelEnabled) target: self; label: 'Mercury Panel'; description: 'Adds the mercury panel to OmniBrowser. This panel is the one on top to search senders, implementors, and references.'. (aBuilder setting: #chasingBrowsersEnabled) target: self; label: 'Chasing Browsers'; description: 'Use recursive multi-column browsers for senders, implementors, and references.' ]! ! !OBCodeBrowser methodsFor: 'morphic' stamp: 'cwp 1/8/2005 21:55'! addModelItemsToWindowMenu: aMenu Smalltalk at: #SystemBrowser ifPresent: [:class | class addRegistryMenuItemsTo: aMenu inAccountOf: OBSystemBrowserAdaptor new].! ! !OBCodeBrowser methodsFor: 'commands-nodes' stamp: 'lr 10/29/2010 11:40'! autoCategorizeCatCommand ^ OBCmdAutoCategorize! ! !OBCodeBrowser methodsFor: 'commands-buttons' stamp: 'cwp 11/23/2011 12:58'! browseButton ^ OBCmdBrowse! ! !OBCodeBrowser methodsFor: 'commands-nodes' stamp: 'lr 10/29/2010 11:40'! browseCommand ^ OBCmdBrowse! ! !OBCodeBrowser methodsFor: 'commands-nodes' stamp: 'lr 10/29/2010 11:40'! browseHierarchyCommand ^ OBCmdBrowseHierarchy! ! !OBCodeBrowser methodsFor: 'commands-nodes' stamp: 'lr 10/29/2010 11:40'! browseHierarchyImplementorsCommand ^ OBCmdBrowseHierarchyImplementors! ! !OBCodeBrowser methodsFor: 'commands-nodes' stamp: 'lr 10/29/2010 11:40'! browseHierarchySendersCommand ^ OBCmdBrowseHierarchySenders! ! !OBCodeBrowser methodsFor: 'commands-nodes' stamp: 'lr 10/29/2010 11:40'! browseImplementorsCommand ^ OBCmdBrowseImplementors! ! !OBCodeBrowser methodsFor: 'commands-nodes' stamp: 'lr 10/29/2010 11:40'! browseImplementorsOfItCommand ^ OBCmdBrowseImplementorsOfIt! ! !OBCodeBrowser methodsFor: 'commands-nodes' stamp: 'lr 10/29/2010 11:40'! browseInheritanceCommand ^ OBCmdBrowseInheritance! ! !OBCodeBrowser methodsFor: 'commands-nodes' stamp: 'lr 10/29/2010 11:40'! browseMethodVersionsCommand ^ OBCmdBrowseMethodVersions! ! !OBCodeBrowser methodsFor: 'commands-nodes' stamp: 'lr 10/29/2010 11:40'! browseReferencesCommand ^ OBCmdBrowseReferences! ! !OBCodeBrowser methodsFor: 'commands-nodes' stamp: 'lr 10/29/2010 11:40'! browseReferencesOfItCommand ^ OBCmdBrowseReferencesOfIt! ! !OBCodeBrowser methodsFor: 'commands-nodes' stamp: 'lr 10/29/2010 11:51'! browseSendersCommand ^ OBCmdBrowseSenders! ! !OBCodeBrowser methodsFor: 'commands-nodes' stamp: 'lr 10/29/2010 11:40'! browseSendersOfItCommand ^ OBCmdBrowseSendersOfIt! ! !OBCodeBrowser methodsFor: 'commands-nodes' stamp: 'lr 10/29/2010 11:40'! chaseVariablesCommand ^ OBCmdChaseVariables! ! !OBCodeBrowser methodsFor: 'updating' stamp: 'cwp 1/7/2005 23:47'! clearChanges hasChanges := false! ! !OBCodeBrowser methodsFor: 'commands-nodes' stamp: 'lr 10/29/2010 11:40'! compareToCurrentCommand ^ OBCmdCompareToCurrent! ! !OBCodeBrowser methodsFor: 'commands-nodes' stamp: 'lr 10/29/2010 11:40'! copyClassCommand ^ OBCmdCopyClass! ! !OBCodeBrowser methodsFor: 'commands-nodes' stamp: 'lr 10/29/2010 11:52'! createCatCommands ^ Array with: OBCmdCreateClassCategory with: OBCmdCreateMethodCategory! ! !OBCodeBrowser methodsFor: 'updating' stamp: 'dr 10/24/2008 18:57'! event: anEvent self noteChanges! ! !OBCodeBrowser methodsFor: 'commands-nodes' stamp: 'lr 10/29/2010 11:40'! fileOutCommand ^ OBCmdFileOut! ! !OBCodeBrowser methodsFor: 'commands-nodes' stamp: 'lr 10/29/2010 11:40'! findClassCommand ^ OBCmdFindClass! ! !OBCodeBrowser methodsFor: 'commands-buttons' stamp: 'cwp 11/23/2011 13:03'! hierarchyButton ^ OBCmdBrowseHierarchy! ! !OBCodeBrowser methodsFor: 'commands-buttons' stamp: 'cwp 11/23/2011 13:01'! implementorsButton ^ OBCmdBrowseImplementors! ! !OBCodeBrowser methodsFor: 'commands-buttons' stamp: 'cwp 11/23/2011 13:03'! inheritanceButton ^ OBCmdBrowseInheritance! ! !OBCodeBrowser methodsFor: 'initializing' stamp: 'lr 3/13/2010 16:09'! initialize super initialize. hasChanges := false. self register! ! !OBCodeBrowser methodsFor: 'testing' stamp: 'cwp 4/18/2007 23:48'! isClassBrowser ^ false! ! !OBCodeBrowser methodsFor: 'testing' stamp: 'dr 2/7/2008 17:20'! isSearchBrowser ^ false! ! !OBCodeBrowser methodsFor: 'commands-nodes' stamp: 'lr 10/29/2010 11:40'! multiViewCommand ^ OBCmdMultiView! ! !OBCodeBrowser methodsFor: 'commands-nodes' stamp: 'lr 10/29/2010 11:40'! newClassTemplateCommand ^ OBCmdNewClassTemplate! ! !OBCodeBrowser methodsFor: 'updating' stamp: 'cwp 4/15/2007 23:07'! noteChanges hasChanges := true! ! !OBCodeBrowser methodsFor: 'updating' stamp: 'dr 10/24/2008 16:06'! register SystemChangeNotifier uniqueInstance notify: self ofAllSystemChangesUsing: #event:.! ! !OBCodeBrowser methodsFor: 'morphic' stamp: 'dr 7/16/2008 15:19'! release "work-around for bug #7119" super release. self panels do: [:panel | panel release].! ! !OBCodeBrowser methodsFor: 'commands-nodes' stamp: 'lr 10/29/2010 11:40'! removeCatCommand ^ OBCmdRemoveCat! ! !OBCodeBrowser methodsFor: 'commands-nodes' stamp: 'lr 10/29/2010 11:40'! removeClassCommand ^ OBCmdRemoveClass! ! !OBCodeBrowser methodsFor: 'commands-nodes' stamp: 'lr 10/29/2010 11:40'! removeElementCommand ^ OBCmdRemoveElement! ! !OBCodeBrowser methodsFor: 'commands-nodes' stamp: 'lr 10/29/2010 11:40'! removeEmptyCatsCommand ^ OBCmdRemoveEmptyCats! ! !OBCodeBrowser methodsFor: 'commands-nodes' stamp: 'lr 10/29/2010 11:40'! removeMethodCommand ^ OBCmdRemoveMethod! ! !OBCodeBrowser methodsFor: 'commands-nodes' stamp: 'lr 10/29/2010 11:52'! renameCatCommands ^ Array with: OBCmdRenameClassCategory with: OBCmdRenameMethodCategory! ! !OBCodeBrowser methodsFor: 'commands-nodes' stamp: 'lr 10/29/2010 11:40'! renameClassCommand ^ OBCmdRenameClass! ! !OBCodeBrowser methodsFor: 'commands-nodes' stamp: 'lr 10/29/2010 11:40'! reorgCatsCommand ^ OBCmdReorgCats! ! !OBCodeBrowser methodsFor: 'commands-nodes' stamp: 'lr 10/29/2010 11:40'! revertMethodCommand ^ OBCmdRevertMethod! ! !OBCodeBrowser methodsFor: 'commands-nodes' stamp: 'lr 10/29/2010 11:40'! selectMethodCategoryCommand ^ OBCmdSelectMethodCategory! ! !OBCodeBrowser methodsFor: 'commands-buttons' stamp: 'cwp 11/23/2011 13:01'! sendersButton ^ OBCmdBrowseSenders! ! !OBCodeBrowser methodsFor: 'morphic' stamp: 'lr 3/13/2010 16:07'! stepAt: milliseconds in: aSystemWindow hasChanges ifTrue: [ self signalRefresh ]. self clearChanges! ! !OBCodeBrowser methodsFor: 'commands-nodes' stamp: 'lr 10/29/2010 11:40'! subclassTemplateCommand ^ OBCmdSubclassTemplate! ! !OBCodeBrowser methodsFor: 'updating' stamp: 'dr 10/24/2008 16:06'! unregister SystemChangeNotifier uniqueInstance noMoreNotificationsFor: self. ! ! !OBCodeBrowser methodsFor: 'commands-buttons' stamp: 'cwp 11/23/2011 13:04'! variablesButton ^ OBCmdChaseVariables! ! !OBCodeBrowser methodsFor: 'commands-buttons' stamp: 'cwp 11/23/2011 13:01'! versionsButton ^ OBCmdBrowseMethodVersions! ! !OBCodeBrowser methodsFor: 'commands-buttons' stamp: 'cwp 11/23/2011 13:07'! viewButton ^ OBCmdMultiView! ! !OBCodeBrowser methodsFor: 'morphic' stamp: 'lr 3/13/2010 16:08'! wantsStepsIn: aSystemWindow ^ true! ! !OBCodeBrowser methodsFor: 'morphic' stamp: 'dr 11/20/2008 09:51'! windowIsClosing self unregister! ! OBCodeBrowser subclass: #OBHierarchyBrowser instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'OB-Standard-Browsers'! !OBHierarchyBrowser commentStamp: 'cwp 1/7/2005 23:50' prior: 0! OBHierarchyBrowser provides a three-pane browers that displays a class within it's surrounding hierarchy - both superclasses and subclasses! !OBHierarchyBrowser class methodsFor: 'configuration' stamp: 'lr 3/14/2010 09:55'! defaultMetaNode | rootClass | rootClass := OBMetaNode named: 'root'. self buildMetagraphOn: rootClass class: #classHierarchy comment: #commentHierarchy metaclass: #metaclassHierarchy. rootClass edges do: [ :each | each metaNode doubleClickSelector: #focusHierarchy: ]. ^ rootClass! ! !OBHierarchyBrowser class methodsFor: 'instance creation' stamp: 'lr 3/6/2006 19:28'! onClass: aClass ^self root: aClass asNode selection: aClass asNode! ! !OBHierarchyBrowser class methodsFor: 'instance creation' stamp: 'lr 9/23/2010 11:36'! onClass: aClass category: aSymbol ^self root: aClass asNode selection: (OBMethodCategoryNode on: aSymbol inClass: aClass)! ! !OBHierarchyBrowser class methodsFor: 'instance creation' stamp: 'lr 9/23/2010 11:39'! onClass: aClass selector: aSymbol ^self root: aClass asNode selection: (OBMethodNode on: aSymbol inClass: aClass)! ! !OBHierarchyBrowser class methodsFor: 'opening' stamp: 'cwp 12/15/2004 22:49'! openOnClass: aClass ^ (self onClass: aClass) open! ! !OBHierarchyBrowser class methodsFor: 'opening' stamp: 'lr 9/23/2010 11:36'! openOnClass: aClass category: aSymbol ^ (self onClass: aClass category: aSymbol) open! ! !OBHierarchyBrowser class methodsFor: 'opening' stamp: 'lr 9/23/2010 11:37'! openOnClass: aClass selector: aSymbol ^ (self onClass: aClass selector: aSymbol) open! ! !OBHierarchyBrowser class methodsFor: 'configuration' stamp: 'cwp 12/13/2004 00:37'! paneCount ^ 3! ! !OBHierarchyBrowser class methodsFor: 'configuration' stamp: 'cwp 12/13/2004 01:00'! titleForRoot: aNode ^ aNode name, ' Hierarchy'! ! !OBHierarchyBrowser methodsFor: 'building' stamp: 'lr 8/15/2010 15:34'! defaultBackgroundColor ^ Color lightGreen! ! !OBHierarchyBrowser methodsFor: 'accessing' stamp: 'cwp 12/13/2004 01:00'! defaultLabel ^ self root name, ' Hierarchy'! ! OBCodeBrowser subclass: #OBInheritanceBrowser instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'OB-Standard-Browsers'! !OBInheritanceBrowser commentStamp: 'cwp 1/7/2005 23:51' prior: 0! OBInheritanceBrowser shows the inheritance hierarchy of a method, both superclass implementations which it overrides, and subclass implementations which override it.! !OBInheritanceBrowser class methodsFor: 'configuration' stamp: 'lr 12/4/2011 18:31'! defaultMetaNode | method root | method := OBMetaNode named: 'Method'. root := OBMetaNode named: 'Root'. root childAt: #children put: method. method displaySelector: #fullName; ancestrySelector: #isDescendantOfMethod:; childAt: #overrides put: method; addFilter: OBClassSortFilter new. ^ root! ! !OBInheritanceBrowser class methodsFor: 'configuration' stamp: ''! title ^ 'Inheritance'! ! !OBInheritanceBrowser class methodsFor: 'configuration' stamp: 'cwp 11/25/2004 22:05'! titleForRoot: aCollectionNode ^ 'Inheritance of ', aCollectionNode children first selector printString! ! !OBInheritanceBrowser methodsFor: 'morphic' stamp: 'avi 11/29/2004 21:52'! defaultBackgroundColor ^ Color lightGreen! ! OBCodeBrowser subclass: #OBListBrowser instanceVariableNames: 'labelPrefix label' classVariableNames: '' poolDictionaries: '' category: 'OB-Standard-Browsers'! !OBListBrowser commentStamp: 'cwp 1/7/2005 23:53' prior: 0! OBListBrowsers are used to display simple lists of methods, such as senders or implementors.! OBListBrowser subclass: #OBImplementorsBrowser instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'OB-Standard-Browsers'! OBImplementorsBrowser subclass: #OBHierarchyImplementorsBrowser instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'OB-Standard-Browsers'! !OBHierarchyImplementorsBrowser class methodsFor: 'configuration' stamp: 'lr 3/13/2010 12:15'! defaultMetaNode ^self implementorsMetaNode: #hierarchyImplementors! ! !OBHierarchyImplementorsBrowser class methodsFor: 'configuration' stamp: 'dr 4/17/2007 16:53'! title ^'Hierarchy Implementors of'! ! !OBImplementorsBrowser class methodsFor: 'configuration' stamp: 'lr 3/13/2010 12:15'! defaultMetaNode ^self implementorsMetaNode: #implementors.! ! !OBImplementorsBrowser class methodsFor: 'configuration' stamp: 'lr 8/15/2010 15:28'! implementorsMetaNode: aNavigationSelector | selector message implementor | selector := OBMetaNode named: 'Selector'. message := OBMetaNode named: 'Message'. implementor := OBMetaNode named: 'Implementor'. selector childAt: aNavigationSelector put: implementor; addFilter: OBClassSortFilter new. implementor displaySelector: #fullNameWithProtocol. self chasingBrowsersEnabled ifTrue: [ implementor childAt: #messages put: message. message childAt: aNavigationSelector put: implementor ]. ^ selector! ! !OBImplementorsBrowser class methodsFor: 'configuration' stamp: 'avi 9/17/2005 01:36'! title ^ 'Implementors of'! ! !OBListBrowser class methodsFor: 'opening' stamp: 'lr 4/9/2011 17:49'! browseRoot: aNode ^ self browseRoot: aNode title: self title! ! !OBListBrowser class methodsFor: 'opening' stamp: 'lr 4/9/2011 17:50'! browseRoot: aNode label: aString ^ (self metaNode: self defaultMetaNode root: aNode selection: nil) label: aString; open ! ! !OBListBrowser class methodsFor: 'opening' stamp: 'lr 4/9/2011 17:50'! browseRoot: aNode title: aString ^ (self metaNode: self defaultMetaNode root: aNode selection: nil) labelPrefix: aString; open ! ! !OBListBrowser class methodsFor: 'configuration' stamp: 'cwp 12/5/2004 17:54'! maxPanes ^ 2! ! !OBListBrowser class methodsFor: 'configuration' stamp: 'cwp 12/5/2004 17:54'! minPanes ^ 1! ! !OBListBrowser methodsFor: 'morphic' stamp: 'dr 9/22/2008 11:28'! defaultBackgroundColor ^ Color lightBlue ! ! !OBListBrowser methodsFor: 'accessing' stamp: 'lr 3/4/2009 08:17'! defaultLabel label isNil ifFalse: [ ^ label ]. ^ self labelPrefix , ' ' , self root name printString! ! !OBListBrowser methodsFor: 'accessing' stamp: 'dr 2/10/2009 16:23'! label: aString label := aString! ! !OBListBrowser methodsFor: 'accessing' stamp: 'cwp 11/25/2004 22:18'! labelPrefix ^ labelPrefix ifNil: [labelPrefix := self root metaNode edges first label capitalized, ' of']! ! !OBListBrowser methodsFor: 'accessing' stamp: 'cwp 10/17/2004 20:54'! labelPrefix: aString labelPrefix := aString! ! OBListBrowser subclass: #OBMethodStringsBrowser instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'OB-Standard-Browsers'! !OBMethodStringsBrowser class methodsFor: 'instance creation' stamp: 'lr 4/9/2011 09:26'! browseRoot: aNode target: targetNode ^ (self root: aNode selection: targetNode) open! ! !OBMethodStringsBrowser class methodsFor: 'configuration' stamp: 'DM 5/23/2007 20:43'! defaultMetaNode | matches selection | selection := OBMetaNode named: 'Selection'. matches := OBMetaNode named: 'Methods'. selection childAt: #methods put: matches. matches displaySelector: #fullName; ancestrySelector: #isAncestorOf:. ^ selection! ! !OBMethodStringsBrowser methodsFor: 'accessing' stamp: 'DM 5/23/2007 20:24'! defaultLabel ^ 'Methods with literal', self selectorString, self numOfMatchesString! ! !OBMethodStringsBrowser methodsFor: 'accessing' stamp: 'DM 5/23/2007 20:26'! numOfMatchesString ^ '[' , self root methods size asString , ']'! ! !OBMethodStringsBrowser methodsFor: 'accessing' stamp: 'DM 5/23/2007 20:23'! selectorString ^ ' ''', self root selector string, ''' '! ! OBListBrowser subclass: #OBReferencesBrowser instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'OB-Standard-Browsers'! !OBReferencesBrowser class methodsFor: 'configuration' stamp: 'lr 8/15/2010 15:28'! defaultMetaNode | class method sender | class := OBMetaNode named: 'Class'. method := OBMetaNode named: 'References'. sender := OBMetaNode named: 'Sender'. class childAt: #users put: method. method displaySelector: #fullNameWithProtocol. self chasingBrowsersEnabled ifTrue: [ method childAt: #senders put: sender. sender displaySelector: #fullNameWithProtocol; childAt: #senders put: sender ]. ^ class! ! !OBReferencesBrowser class methodsFor: 'configuration' stamp: 'avi 9/17/2005 01:34'! title ^ 'References to'! ! OBListBrowser subclass: #OBSendersBrowser instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'OB-Standard-Browsers'! OBSendersBrowser subclass: #OBHierarchySendersBrowser instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'OB-Standard-Browsers'! !OBHierarchySendersBrowser class methodsFor: 'configuration' stamp: 'lr 3/13/2010 12:15'! defaultMetaNode ^self sendersMetaNode: #hierarchySenders. ! ! !OBHierarchySendersBrowser class methodsFor: 'configuration' stamp: 'dr 7/2/2007 16:55'! title ^'Hierarchy Senders of' ! ! !OBSendersBrowser class methodsFor: 'defaults' stamp: 'lr 3/13/2010 12:15'! defaultMetaNode ^self sendersMetaNode: #senders! ! !OBSendersBrowser class methodsFor: 'configuration' stamp: 'lr 8/15/2010 15:28'! sendersMetaNode: aNavigationSelector | selector sender | selector := OBMetaNode named: 'Selector'. sender := OBMetaNode named: 'Sender'. selector childAt: aNavigationSelector put: sender; addFilter: OBRescueFilter new. sender displaySelector: #fullNameWithProtocol; addFilter: OBRescueFilter new. self chasingBrowsersEnabled ifTrue: [ sender childAt: aNavigationSelector put: sender ]. ^ selector ! ! !OBSendersBrowser class methodsFor: 'configuration' stamp: 'avi 9/17/2005 01:36'! title ^ 'Senders of'! ! OBListBrowser subclass: #OBVariablesBrowser instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'OB-Standard-Browsers'! !OBVariablesBrowser class methodsFor: 'instance creation' stamp: 'lr 11/7/2009 17:54'! browseRoot: aNode ^ self browseRoot: aNode label: self title , ' ' , aNode theClassName! ! !OBVariablesBrowser class methodsFor: 'configuration' stamp: 'lr 4/9/2011 18:14'! defaultMetaNode | class variable method message | class := OBMetaNode named: 'Class'. variable := OBMetaNode named: 'Variable'. method := OBMetaNode named: 'Method'. message := OBMetaNode named: 'Message'. class childAt: #instanceVariables labeled: 'Instance' put: variable; childAt: #classVariables labeled: 'Class' put: variable; addFilter: OBModalFilter new. variable childAt: #accessors put: method; ancestrySelector: #isDescendantOfVariable:; addFilter: OBClassSortFilter new. method displaySelector: #fullName. self chasingBrowsersEnabled ifTrue: [ variable addFilter: OBModalFilter new. method childAt: #senders put: message; addFilter: OBModalFilter new. message displaySelector: #fullName; childAt: #senders put: message; addFilter: OBModalFilter new ]. ^ class! ! !OBVariablesBrowser class methodsFor: 'configuration' stamp: 'cwp 11/9/2011 11:15'! maxPanes ^ 3! ! !OBVariablesBrowser class methodsFor: 'configuration' stamp: 'avi 5/30/2007 22:13'! minPanes ^ 2! ! !OBVariablesBrowser class methodsFor: 'configuration' stamp: 'avi 9/17/2005 01:35'! title ^ 'Variables of'! ! OBCodeBrowser subclass: #OBSearchBrowser instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'OB-Standard-Browsers'! !OBSearchBrowser class methodsFor: 'configuration' stamp: 'cwp 5/19/2007 23:33'! defaultMetaNode | root search | root := OBMetaNode named: 'root'. search := OBMetaNode named: 'search'. root childAt: #children put: search. self buildMetagraphOn: search. ^root! ! !OBSearchBrowser class methodsFor: 'configuration' stamp: 'cwp 4/1/2007 22:56'! defaultRootNode ^ OBCollectionNode on: IdentitySet new! ! !OBSearchBrowser class methodsFor: 'configuration' stamp: 'lr 2/17/2009 20:55'! mercuryPanel ^ OBMercuryPanel new! ! !OBSearchBrowser class methodsFor: 'configuration' stamp: 'cwp 4/16/2007 00:18'! title ^ 'Search Browser'! ! !OBSearchBrowser class methodsFor: 'instance creation' stamp: 'cwp 4/15/2007 23:20'! with: aSearchNode ^ self metaNode: self defaultMetaNode root: (OBCollectionNode on: (OrderedCollection with: aSearchNode)) selection: aSearchNode! ! !OBSearchBrowser methodsFor: 'building' stamp: 'cwp 4/1/2007 23:01'! defaultBackgroundColor ^ Color lightGreen ! ! !OBSearchBrowser methodsFor: 'testing' stamp: 'cwp 4/15/2007 22:28'! isSearchBrowser ^ true! ! !OBSearchBrowser methodsFor: 'commands' stamp: 'lr 10/29/2010 11:40'! resetSearchCommand ^ OBCmdResetSearch! ! OBCodeBrowser subclass: #OBSystemBrowser instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'OB-Standard-Browsers'! !OBSystemBrowser commentStamp: 'cwp 1/7/2005 23:56' prior: 0! This is the basic system browser that is the work-horse of Smalltalk development tools. It presents four panes showing class categories, classes, method categories and methods.! !OBSystemBrowser class methodsFor: 'configuration' stamp: 'lr 4/3/2009 13:42'! defaultMetaNode | env classCategory | env := OBMetaNode named: 'Environment'. classCategory := OBMetaNode named: 'ClassCategory'. env childAt: #categories put: classCategory. classCategory ancestrySelector: #isDescendantOfClassCat:. self buildMetagraphOn: classCategory. classCategory edges do: [ :each | each metaNode doubleClickSelector: #browseHierarchy ]. ^env! ! !OBSystemBrowser class methodsFor: 'configuration' stamp: 'dr 7/20/2007 15:23'! defaultRootNode ^ OBEnvironmentNode forImage! ! !OBSystemBrowser class methodsFor: 'instance creation' stamp: 'dvf 8/31/2005 13:17'! onClass: aClass ^self selection: aClass asNode! ! !OBSystemBrowser class methodsFor: 'instance creation' stamp: 'cwp 12/15/2004 21:42'! onClass: aClass category: aSymbol ^ self selection: (OBMethodCategoryNode on: aSymbol inClass: aClass)! ! !OBSystemBrowser class methodsFor: 'instance creation' stamp: 'cwp 12/5/2004 17:38'! onClass: aClass selector: aSelector ^ self selection: (OBMethodNode on: aSelector inClass: aClass)! ! !OBSystemBrowser class methodsFor: 'instance creation' stamp: 'lr 3/4/2010 20:19'! onEnvironment: anEnvironment category: aSymbol ^ self selection: (OBClassCategoryNode on: aSymbol inEnvironment: anEnvironment)! ! !OBSystemBrowser class methodsFor: 'opening' stamp: 'cwp 12/5/2004 18:32'! openOnClass: aClass ^ (self onClass: aClass) open! ! !OBSystemBrowser class methodsFor: 'opening' stamp: 'cwp 12/15/2004 21:47'! openOnClass: aClass category: aSymbol ^ (self onClass: aClass category: aSymbol) open! ! !OBSystemBrowser class methodsFor: 'opening' stamp: 'lr 4/9/2011 17:50'! openOnClass: aClass selector: aSelector ^ aSelector isNil ifTrue: [ (self onClass: aClass) open ] ifFalse: [ (self onClass: aClass selector: aSelector) open ]! ! !OBSystemBrowser class methodsFor: 'opening' stamp: 'cwp 12/15/2004 21:54'! openOnEnvironment: anEnvironment category: aSymbol ^ (self onEnvironment: anEnvironment category: aSymbol) open! ! !OBSystemBrowser class methodsFor: 'configuration' stamp: 'lr 7/4/2009 16:48'! title ^ 'System Browser'! ! !OBSystemBrowser methodsFor: 'morphic' stamp: 'lr 8/15/2010 15:35'! defaultBackgroundColor ^ Color lightGreen! ! !OBSystemBrowser methodsFor: 'testing' stamp: 'cwp 4/18/2007 23:49'! isClassBrowser ^ true! ! !OBSystemBrowser methodsFor: 'morphic' stamp: 'cwp 9/13/2009 10:41'! labelString ^ self navigationPanel labelString ifNil: [ self defaultLabel ]! ! OBCodeBrowser subclass: #OBVersionBrowser instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'OB-Standard-Browsers'! !OBVersionBrowser commentStamp: 'cwp 1/7/2005 23:58' prior: 0! OBVersionBrowser displays a list of OBMethodVersions, which represent versions of a method present in the source or changes files. ! !OBVersionBrowser class methodsFor: 'configuration' stamp: 'dr 9/17/2008 13:48'! defaultMetaNode | version | version := OBMetaNode named: 'Version'. version ancestrySelector: #isDescendantOfMethodVersion:. ^ (OBMetaNode named: 'Method') childAt: #versions put: version; yourself.! ! !OBVersionBrowser class methodsFor: 'configuration' stamp: 'cwp 11/27/2004 22:32'! maxPanes ^ 1! ! !OBVersionBrowser class methodsFor: 'configuration' stamp: 'cwp 11/27/2004 22:32'! minPanes ^ 1! ! !OBVersionBrowser class methodsFor: 'opening' stamp: 'lr 4/25/2007 09:51'! openOn: aMethodVersionNode ^ (self root: aMethodVersionNode selection: aMethodVersionNode versions first) open! ! !OBVersionBrowser methodsFor: 'commands-buttons' stamp: 'cwp 11/23/2011 23:55'! compareButton ^ OBCmdCompareToCurrent! ! !OBVersionBrowser methodsFor: 'morphic' stamp: 'avi 11/29/2004 21:52'! defaultBackgroundColor ^ Color lightMagenta! ! !OBVersionBrowser methodsFor: 'accessing' stamp: 'cwp 11/27/2004 22:28'! defaultLabel ^ 'Versions of ', self root name printString! ! !OBVersionBrowser methodsFor: 'commands-buttons' stamp: 'cwp 11/23/2011 23:56'! revertButton ^ OBCmdRevertMethod! ! !OBVersionBrowser methodsFor: 'commands-buttons' stamp: 'cwp 11/23/2011 23:58'! versionsButton "Override the inherited implmentation since it makes no sense in this browser" ^ nil! ! !ClassDescription methodsFor: '*ob-standard' stamp: 'dvf 8/17/2005 17:31'! asCommentNode ^ OBClassCommentNode on: self theNonMetaClass ! ! !ClassDescription methodsFor: '*ob-standard' stamp: 'lr 1/3/2010 16:11'! browserIcon "Answer an icon to be show in the browser for the receiving class." ^ #blank! ! !ClassDescription methodsFor: '*ob-standard' stamp: 'DamienPollet 10/15/2010 14:17'! browserIcon: aClassDescription selector: aSelector "Answer an icon to be shown for the selector aSymbol in aClassDescription." aClassDescription methodDictionary at: aSelector ifPresent: [ :method | method literalsDo: [ :literal | (literal == #halt or: [ literal == #halt: or: [ literal == #haltIfNil or: [ literal == #haltIf: or: [ literal == #haltOnce or: [ literal == #haltOnce: or: [ literal == #haltOnCount: or: [ literal == #halt:onCount: ] ] ] ] ] ] ]) ifTrue: [ ^ #breakpoint ]. (literal == #flag: or: [ literal == #needsWork or: [ literal == #notYetImplemented or: [ literal == #isThisEverCalled ] ] ]) ifTrue: [ ^ #flag ] ] ]. ^ (aClassDescription isOverride: aSelector) ifTrue: [ (aClassDescription isOverridden: aSelector) ifTrue: [ #arrowUpAndDown ] ifFalse: [ #arrowUp ] ] ifFalse: [ (aClassDescription isOverridden: aSelector) ifTrue: [ #arrowDown ] ifFalse: [ #blank ] ]! ! !ClassDescription methodsFor: '*ob-standard' stamp: 'lr 1/3/2010 16:00'! isOverridden: aSelector self allSubclassesDo: [ :class | (class includesSelector: aSelector) ifTrue: [ ^ true ] ]. ^ false! ! !ClassDescription methodsFor: '*ob-standard' stamp: 'lr 1/3/2010 15:59'! isOverride: aSelector self allSuperclassesDo: [ :class | (class includesSelector: aSelector) ifTrue: [ ^ true ] ]. ^ false! ! !ClassDescription methodsFor: '*ob-standard' stamp: 'lr 3/4/2009 22:06'! package ^ PackageOrganizer default packageOfClass: self ifNone: [ nil ]! ! !Class methodsFor: '*ob-standard-converting' stamp: 'lr 8/4/2007 10:04'! asClassSideNode ^ OBMetaclassNode on: self! ! !Class methodsFor: '*ob-standard-converting' stamp: 'lr 2/12/2009 10:38'! asNode ^ OBClassNode on: self! ! Object subclass: #OBAnnotationRequest instanceVariableNames: 'selector class separator' classVariableNames: '' poolDictionaries: '' category: 'OB-Standard-Utilities'! !OBAnnotationRequest class methodsFor: 'instance-creation' stamp: 'PDC 6/25/2007 22:01'! onClass: aClass selector: aSelector ^ self new onClass: aClass selector: aSelector; yourself! ! !OBAnnotationRequest methodsFor: 'requests' stamp: 'lr 8/15/2010 17:13'! allChangeSets "A list of all change sets bearing the method." | changeSets | changeSets := ChangeSet allChangeSetsWithClass: class selector: selector. ^ changeSets isEmpty ifFalse: [ String streamContents: [ :aStream | changeSets size = 1 ifTrue: [ aStream nextPutAll: 'only in change set ' ] ifFalse: [ aStream nextPutAll: 'in change sets: ' ]. changeSets do: [ :aChangeSet | aStream nextPutAll: aChangeSet name; nextPutAll: ' ' ] ] ] ifTrue: [ 'in no change set' ]! ! !OBAnnotationRequest methodsFor: 'actions' stamp: 'cwp 11/8/2011 14:57'! annotationRequests ^ OBPlatform current annotationRequests! ! !OBAnnotationRequest methodsFor: 'requests' stamp: 'lr 8/15/2010 17:11'! documentation "Comment at beginning of the method or, if it has none, comment at the beginning of a superclass's implementation of the method." ^ class precodeCommentOrInheritedCommentFor: selector! ! !OBAnnotationRequest methodsFor: 'requests' stamp: 'lr 8/15/2010 17:10'! firstComment "The first comment in the method, if any." ^ class firstCommentAt: selector! ! !OBAnnotationRequest methodsFor: 'actions' stamp: 'lr 8/15/2010 17:10'! getAnnotations ^ String streamContents: [ :aStream | ((self annotationRequests collect: [ :request | self perform: request ]) reject: [ :stringOrNil | stringOrNil isEmptyOrNil ]) do: [ :each | aStream nextPutAll: each ] separatedBy: [ aStream nextPutAll: separator ] ]! ! !OBAnnotationRequest methodsFor: 'requests' stamp: 'lr 8/15/2010 17:13'! implementorsCount "A report of how many implementors there are of the message." | implementorsCount | implementorsCount := self systemNavigation numberOfImplementorsOf: selector. ^ implementorsCount = 1 ifTrue: [ '1 implementor' ] ifFalse: [ implementorsCount printString , ' implementors' ]! ! !OBAnnotationRequest methodsFor: 'requests' stamp: 'lr 8/15/2010 17:11'! masterComment "The comment at the beginning of the supermost implementor of the method if any." ^ class supermostPrecodeCommentFor: selector! ! !OBAnnotationRequest methodsFor: 'requests' stamp: 'lr 8/15/2010 17:15'! messageCategory "Which method category the method lies in." ^ class organization categoryOfElement: selector! ! !OBAnnotationRequest methodsFor: 'accessing' stamp: 'dc 6/18/2007 18:55'! method ^ class compiledMethodAt: selector ifAbsent: [nil]! ! !OBAnnotationRequest methodsFor: 'initialization' stamp: 'MAD 1/14/2009 11:44'! onClass: aClass selector: aSelector class := aClass. selector := aSelector. separator := ' - '.! ! !OBAnnotationRequest methodsFor: 'requests' stamp: 'lr 8/15/2010 17:15'! priorTimeStamp "The time stamp of the penultimate submission of the method, if any." | stamp | ^ (stamp := VersionsBrowser timeStampFor: selector class: class reverseOrdinal: 2) isNil ifFalse: [ 'prior time stamp: ' , stamp ]! ! !OBAnnotationRequest methodsFor: 'requests' stamp: 'lr 8/15/2010 17:14'! priorVersionsCount "A report of how many previous versions there are of the method." | versionsCount | versionsCount := VersionsBrowser versionCountForSelector: selector class: class. ^ versionsCount > 1 ifTrue: [ versionsCount = 2 ifTrue: [ '1 prior version' ] ifFalse: [ versionsCount printString, ' prior versions' ] ] ifFalse: [ 'no prior versions' ]! ! !OBAnnotationRequest methodsFor: 'requests' stamp: 'lr 8/15/2010 17:13'! recentChangeSet "The most recent change set bearing the method." ^ ChangeSet mostRecentChangeSetWithChangeForClass: class selector: selector! ! !OBAnnotationRequest methodsFor: 'requests' stamp: 'lr 8/15/2010 17:12'! sendersCount "A report of how many senders there of the message." | sendersCount | sendersCount := (self systemNavigation allCallsOn: selector) size. ^ sendersCount = 1 ifTrue: [ '1 sender' ] ifFalse: [ sendersCount printString , ' senders' ]! ! !OBAnnotationRequest methodsFor: 'accessing' stamp: 'dc 5/2/2007 18:14'! separator: aString separator := aString! ! !OBAnnotationRequest methodsFor: 'requests' stamp: 'lr 8/15/2010 17:10'! timeStamp "The time stamp of the last submission of the method." ^ self method isNil ifFalse: [ self method timeStamp ]! ! Object subclass: #OBBrowserPlatform instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'OB-Standard-Utilities'! !OBBrowserPlatform class methodsFor: 'accessing' stamp: 'lr 5/22/2010 09:38'! changeStamp Smalltalk at: #Utilities ifPresent: [ :utils | (utils respondsTo: #changeStamp) ifTrue: [ ^ utils changeStamp ] ]. ^ Author changeStamp! ! Object subclass: #OBClassReference instanceVariableNames: 'name isMeta' classVariableNames: '' poolDictionaries: '' category: 'OB-Standard-Utilities'! !OBClassReference commentStamp: 'cwp 1/8/2005 13:15' prior: 0! OBClassReference provides a way to refer to classes that may or may not be loaded into the image. It refers to the class indirectly, via name, rather than with a direct pointer to the class object. It also provides a number of convenience methods, which makes it more convenient than using the class name directly.! !OBClassReference class methodsFor: 'instance creation' stamp: ''! named: aSymbol ^ self new setName: aSymbol! ! !OBClassReference class methodsFor: 'instance creation' stamp: ''! to: aClass ^ self named: aClass name! ! !OBClassReference methodsFor: 'comparing' stamp: ''! <= other ^ self name <= other name! ! !OBClassReference methodsFor: 'comparing' stamp: 'lr 11/13/2008 13:44'! = other ^ (other isKindOf: self class) and: [ name = other theNonMetaName and: [ isMeta = other isMeta ] ]! ! !OBClassReference methodsFor: 'accessing' stamp: ''! beMeta isMeta := true! ! !OBClassReference methodsFor: 'comparing' stamp: ''! hash ^ isMeta ifTrue: [name hash bitInvert] ifFalse: [name hash]! ! !OBClassReference methodsFor: 'testing' stamp: ''! isMeta ^ isMeta! ! !OBClassReference methodsFor: 'accessing' stamp: ''! name ^ isMeta ifTrue: [name, ' class'] ifFalse: [name]! ! !OBClassReference methodsFor: 'printing' stamp: ''! printOn: aStream aStream nextPutAll: 'OBClassReference'. aStream nextPut: $<. aStream nextPutAll: name. isMeta ifTrue: [aStream nextPutAll: ' class']. aStream nextPut: $>.! ! !OBClassReference methodsFor: 'initializing' stamp: ''! setName: aSymbol name := (aSymbol copyUpTo: $ ) asSymbol. isMeta := aSymbol endsWith: ' class'.! ! !OBClassReference methodsFor: 'accessing' stamp: ''! theClass | theClass | theClass := self theNonMetaClass ifNil: [^ nil]. ^ isMeta ifFalse: [theClass] ifTrue: [theClass class]! ! !OBClassReference methodsFor: 'accessing' stamp: ''! theNonMetaClass ^ Smalltalk at: name ifAbsent: [].! ! !OBClassReference methodsFor: 'accessing' stamp: ''! theNonMetaName ^ name! ! Object subclass: #OBMercuryQuery instanceVariableNames: 'pattern isWild browser' classVariableNames: '' poolDictionaries: '' category: 'OB-Standard-Utilities'! !OBMercuryQuery commentStamp: 'PDC 6/29/2007 07:08' prior: 0! OBMercuryQuery is an abstract superclass for queries made through the 'Mercury' panel in OmniBrowser based browser. The main interface is the class method, find:for:, which builds an appropriate concrete query object for the query string and calls find on it.! OBMercuryQuery subclass: #OBMClassQuery instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'OB-Standard-Utilities'! !OBMClassQuery commentStamp: 'PDC 6/29/2007 07:11' prior: 0! I handle mercury queries like 'Object' and 'OBNode*'. I find classes.! !OBMClassQuery class methodsFor: 'configuration' stamp: 'lr 3/13/2010 14:37'! isValidQuery: aString ^ (aString size > 1 and: [ aString first = $* and: [ aString second ~= $* ] ]) or: [ (aString size > 1 and: [ aString first isUppercase ]) or: [ (aString allButLast indexOf: $*) > 1 ] ]! ! !OBMClassQuery class methodsFor: 'configuration' stamp: 'lr 3/13/2010 14:21'! priority ^ 40! ! !OBMClassQuery methodsFor: 'private' stamp: 'lr 4/5/2010 12:37'! find | searchNode classes | self browser isSearchBrowser ifTrue: [ ^ self openSearchBrowser ]. (isWild not and: [ pattern size = 1 and: [ (Smalltalk hasClassNamed: pattern first) ] ]) ifTrue: [ ^ self openClassBrowserOn: (Smalltalk classNamed: pattern first) asNode ]. searchNode := self searchNode. (classes := searchNode classes) size = 1 ifTrue: [ self openClassBrowserOn: classes first ] ifFalse: [ self openSearchBrowserOn: searchNode ]! ! !OBMClassQuery methodsFor: 'private' stamp: 'lr 4/5/2010 12:31'! openClassBrowserOn: aNode ^ self browser isClassBrowser ifTrue: [ self browser jumpTo: aNode ] ifFalse: [ aNode browse ]! ! !OBMClassQuery methodsFor: 'accessing' stamp: 'PDC 6/29/2007 06:17'! searchNode ^ OBClassSearchNode on: pattern! ! !OBMClassQuery methodsFor: 'initialization' stamp: 'cb 7/16/2008 12:05'! setRawQuery: aString panel: aPanel pattern := aString findTokens: #*. isWild := aString includes: $*. browser := aPanel browser. ^ self! ! OBMercuryQuery subclass: #OBMClassRefsQuery instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'OB-Standard-Utilities'! !OBMClassRefsQuery commentStamp: 'PDC 6/29/2007 07:13' prior: 0! I handle mercury queries like '#Object'. I find references to classes.! !OBMClassRefsQuery class methodsFor: 'configuration' stamp: 'lr 3/13/2010 13:31'! isValidQuery: aString ^ aString size > 1 and: [ aString first = $# and: [ aString second isUppercase ] ]! ! !OBMClassRefsQuery class methodsFor: 'configuration' stamp: 'lr 3/13/2010 14:21'! priority ^ 20! ! !OBMClassRefsQuery methodsFor: 'executing' stamp: 'lr 3/4/2009 08:17'! find (Smalltalk classNamed: pattern) isNil ifFalse: [ self openSearchBrowser ]! ! !OBMClassRefsQuery methodsFor: 'accessing' stamp: 'PDC 6/29/2007 06:17'! searchNode ^ OBClassRefSearchNode on: pattern! ! OBMercuryQuery subclass: #OBMMethodQuery instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'OB-Standard-Utilities'! !OBMMethodQuery commentStamp: 'PDC 6/29/2007 07:12' prior: 0! I handle queries that look like 'browse' and 'browse*'. I find method implementors.! !OBMMethodQuery class methodsFor: 'configuration' stamp: 'lr 3/13/2010 13:39'! isValidQuery: aString ^ true! ! !OBMMethodQuery class methodsFor: 'configuration' stamp: 'lr 3/13/2010 14:21'! priority ^ 50! ! !OBMMethodQuery methodsFor: 'private' stamp: 'cwp 9/1/2007 00:26'! browseImplementors | node | node := OBSelectorNode on: pattern asSymbol. (browser announce: (OBShowImplementors of: node)) execute! ! !OBMMethodQuery methodsFor: 'executing' stamp: 'PDC 6/29/2007 06:23'! find isWild ifTrue: [self findMethod] ifFalse: [self browseImplementors]! ! !OBMMethodQuery methodsFor: 'private' stamp: 'PDC 6/29/2007 06:28'! findMethod self openSearchBrowser! ! !OBMMethodQuery methodsFor: 'accessing' stamp: 'dr 5/14/2008 13:26'! searchNode ^ OBMethodSearchNode on: pattern! ! !OBMMethodQuery methodsFor: 'initialization' stamp: 'lr 6/11/2010 19:12'! setRawQuery: aString panel: aPanel super setRawQuery: (aString copyWithoutAll: Character separators) panel: aPanel! ! OBMercuryQuery subclass: #OBMMethodSendersQuery instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'OB-Standard-Utilities'! !OBMMethodSendersQuery commentStamp: 'PDC 6/29/2007 07:13' prior: 0! I handle queries like '#browse'. I find method senders.! !OBMMethodSendersQuery class methodsFor: 'configuration' stamp: 'lr 3/13/2010 14:35'! isValidQuery: aString ^ aString size > 1 and: [ aString first = $# and: [ aString second isLowercase ] ]! ! !OBMMethodSendersQuery class methodsFor: 'configuration' stamp: 'lr 3/13/2010 14:21'! priority ^ 30! ! !OBMMethodSendersQuery methodsFor: 'executing' stamp: 'cwp 8/31/2007 23:54'! find | node | node := OBSelectorNode on: pattern asSymbol. (browser announce: (OBShowSenders of: node)) execute! ! !OBMMethodSendersQuery methodsFor: 'accessing' stamp: 'cwp 7/20/2007 00:25'! searchNode ^ OBSenderSearchNode on: pattern! ! !OBMMethodSendersQuery methodsFor: 'initialization' stamp: 'lr 6/11/2010 19:12'! setRawQuery: aString panel: aPanel super setRawQuery: (aString copyWithoutAll: Character separators) panel: aPanel! ! OBMercuryQuery subclass: #OBMStringQuery instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'OB-Standard-Utilities'! !OBMStringQuery commentStamp: 'PDC 6/29/2007 07:13' prior: 0! I handle queries that look like "'this is a string'". I find strings in methods.! !OBMStringQuery class methodsFor: 'configuration' stamp: 'lr 3/13/2010 13:31'! isValidQuery: aString ^ aString size > 2 and: [ aString first = $' and: [ aString last = $' ] ]! ! !OBMStringQuery class methodsFor: 'configuration' stamp: 'lr 3/13/2010 14:21'! priority ^ 10! ! !OBMStringQuery methodsFor: 'executing' stamp: 'PDC 6/29/2007 05:52'! find self systemNavigation browseMethodsWithString: pattern.! ! !OBMercuryQuery class methodsFor: 'instance creation' stamp: 'lr 3/13/2010 13:19'! find: aText for: aPanel | query | query := self from: aText panel: aPanel. query isNil ifFalse: [ query find ]! ! !OBMercuryQuery class methodsFor: 'instance creation' stamp: 'lr 3/13/2010 13:42'! from: aString panel: aPanel | queryClasses | queryClasses := self allSubclasses select: [ :each | each isValidQuery: aString ]. queryClasses isEmpty ifTrue: [ ^ nil ]. queryClasses := queryClasses asSortedCollection: [ :a :b | a priority < b priority ]. ^ queryClasses first new setRawQuery: aString panel: aPanel! ! !OBMercuryQuery class methodsFor: 'documentation' stamp: 'cb 7/19/2007 21:14'! helpMessage ^'Mercury syntax Foo (browse class Foo) Foo*Bar* (find classes with partial name) #Foo (refs to class Foo) foo (implementors of foo) foo* (implementors of methods starting with foo) #foo (senders of foo) ''foo'' (find methods containing this string)'! ! !OBMercuryQuery class methodsFor: 'configuration' stamp: 'lr 3/13/2010 13:11'! isValidQuery: aString ^ false! ! !OBMercuryQuery class methodsFor: 'configuration' stamp: 'lr 3/13/2010 13:11'! priority ^ 0! ! !OBMercuryQuery methodsFor: 'executing' stamp: 'cwp 7/20/2007 00:24'! announce: anAnnouncement ^ browser announce: anAnnouncement! ! !OBMercuryQuery methodsFor: 'accessing' stamp: 'PDC 6/29/2007 06:04'! browser ^browser! ! !OBMercuryQuery methodsFor: 'executing' stamp: 'PDC 6/29/2007 06:32'! find self subclassResponsibility ! ! !OBMercuryQuery methodsFor: 'actions' stamp: 'PDC 6/29/2007 06:18'! openSearchBrowser ^ self openSearchBrowserOn: self searchNode! ! !OBMercuryQuery methodsFor: 'actions' stamp: 'dr 2/15/2008 14:18'! openSearchBrowserOn: searchNode ^ self browser isSearchBrowser ifFalse: [(OBSearchBrowser with: searchNode) open] ifTrue: [self browser root addChild: searchNode. (self announce: OBAboutToChange) isVetoed ifTrue: [self browser noteChanges] ifFalse: [self announce: (OBSelectingNode node: searchNode)]]! ! !OBMercuryQuery methodsFor: 'accessing' stamp: 'PDC 6/29/2007 06:32'! searchNode self subclassResponsibility ! ! !OBMercuryQuery methodsFor: 'initialization' stamp: 'lr 8/22/2010 11:07'! setRawQuery: aString | tokens | tokens := Scanner new scanTokens: aString. pattern := tokens at: 1 ifAbsent: [ String new ]. isWild := (tokens at: 2 ifAbsent: [ nil ]) = #*! ! !OBMercuryQuery methodsFor: 'initialization' stamp: 'lr 8/22/2010 11:07'! setRawQuery: aString panel: aPanel self setRawQuery: aString. browser := aPanel browser! ! Object subclass: #OBMetagraphBuilder instanceVariableNames: 'metaNodes selectors root' classVariableNames: '' poolDictionaries: '' category: 'OB-Standard-Utilities'! !OBMetagraphBuilder class methodsFor: 'instance creation' stamp: 'PDC 6/27/2007 08:03'! on: root class: classSel comment: commentSel metaclass: metaclassSel ^self new setRoot: root classSel: classSel commentSel: commentSel metaclassSel: metaclassSel! ! !OBMetagraphBuilder methodsFor: 'accessing' stamp: 'dc 9/7/2007 11:55'! addMetaNode: aMetaNode ^ self metaNodes at: aMetaNode name put: aMetaNode! ! !OBMetagraphBuilder methodsFor: 'accessing-metanodes' stamp: 'dc 9/7/2007 11:53'! allMethodCategoryMetaNode ^ self metaNode: #AllMethodCategory! ! !OBMetagraphBuilder methodsFor: 'accessing-metanodes' stamp: 'dc 9/7/2007 11:53'! classCommentMetaNode ^ self metaNode: #ClassComment! ! !OBMetagraphBuilder methodsFor: 'accessing-metanodes' stamp: 'dc 9/7/2007 11:53'! classMetaNode ^ self metaNode: #Class! ! !OBMetagraphBuilder methodsFor: 'accessing-selectors' stamp: 'jk 8/26/2007 18:05'! classSelector ^ self selectorAt: #classSel! ! !OBMetagraphBuilder methodsFor: 'accessing-selectors' stamp: 'jk 8/26/2007 18:05'! classSelector: aSelector ^ self selectorAt: #classSel put: aSelector! ! !OBMetagraphBuilder methodsFor: 'accessing-selectors' stamp: 'jk 8/26/2007 18:05'! commentSelector ^ self selectorAt: #commentSel! ! !OBMetagraphBuilder methodsFor: 'accessing-selectors' stamp: 'jk 8/26/2007 18:06'! commentSelector: aSelector ^ self selectorAt: #commentSel put: aSelector! ! !OBMetagraphBuilder methodsFor: 'execution' stamp: 'lr 4/23/2010 08:40'! execute (Pragma allNamed: #populate in: self class) do: [ :each | self perform: each selector ]. ^ self root! ! !OBMetagraphBuilder methodsFor: 'accessing' stamp: 'lr 8/13/2010 16:36'! metaNode: aMetaNodeName ^ self metaNodes at: aMetaNodeName ifAbsentPut: [ OBMetaNode named: aMetaNodeName ]! ! !OBMetagraphBuilder methodsFor: 'accessing' stamp: 'lr 8/13/2010 16:36'! metaNodes ^ metaNodes ifNil: [ metaNodes := IdentityDictionary new ]! ! !OBMetagraphBuilder methodsFor: 'accessing-metanodes' stamp: 'dc 9/7/2007 11:53'! metaclassMetaNode ^ self metaNode: #Metaclass! ! !OBMetagraphBuilder methodsFor: 'accessing-selectors' stamp: 'jk 8/26/2007 18:06'! metaclassSelector ^ self selectorAt: #metaclassSel! ! !OBMetagraphBuilder methodsFor: 'accessing-selectors' stamp: 'jk 8/26/2007 18:06'! metaclassSelector: aSelector ^ self selectorAt: #metaclassSel put: aSelector! ! !OBMetagraphBuilder methodsFor: 'accessing-metanodes' stamp: 'dc 9/7/2007 11:53'! methodCategoryMetaNode ^ self metaNode: #MethodCategory! ! !OBMetagraphBuilder methodsFor: 'accessing-metanodes' stamp: 'dc 9/7/2007 11:53'! methodMetaNode ^ self metaNode: #Method! ! !OBMetagraphBuilder methodsFor: 'private' stamp: 'lr 4/23/2010 08:38'! populateAllMethodCategoryNode self allMethodCategoryMetaNode childAt: #methods put: self methodMetaNode! ! !OBMetagraphBuilder methodsFor: 'private' stamp: 'lr 4/23/2010 08:38'! populateClassCommentMetaNode self classCommentMetaNode ancestrySelector: #isDescendantOfClass:; addFilter: OBClassIconFilter new! ! !OBMetagraphBuilder methodsFor: 'private' stamp: 'cwp 12/12/2011 16:50'! populateClassNode self classMetaNode ancestrySelector: #isDescendantOfClass:; childAt: #syntheticCategories put: self allMethodCategoryMetaNode; childAt: #categories put: self methodCategoryMetaNode; nullChildAt: #allCategory put: self allMethodCategoryMetaNode; addFilter: OBClassIconFilter new! ! !OBMetagraphBuilder methodsFor: 'private' stamp: 'cwp 12/12/2011 16:52'! populateMetaclassNode self metaclassMetaNode ancestrySelector: #isDescendantOfClass:; childAt: #syntheticCategories put: self allMethodCategoryMetaNode; childAt: #categories put: self methodCategoryMetaNode; nullChildAt: #allCategory put: self allMethodCategoryMetaNode; addFilter: OBClassIconFilter new! ! !OBMetagraphBuilder methodsFor: 'private' stamp: 'lr 4/23/2010 08:39'! populateMethodCategoryNode self methodCategoryMetaNode ancestrySelector: #isDescendantOfMethodCat:; childAt: #methods put: self methodMetaNode! ! !OBMetagraphBuilder methodsFor: 'private' stamp: 'lr 4/23/2010 08:39'! populateMethodNode self methodMetaNode ancestrySelector: #isDescendantOfMethod:; addFilter: OBMethodIconFilter new! ! !OBMetagraphBuilder methodsFor: 'private' stamp: 'lr 8/13/2010 16:37'! populateRoot self root childAt: self classSelector labeled: 'Instance' put: self classMetaNode; childAt: self commentSelector labeled: '?' put: self classCommentMetaNode; childAt: self metaclassSelector labeled: 'Class' put: self metaclassMetaNode; addFilter: OBModalFilter new; addFilter: OBClassSortFilter new ! ! !OBMetagraphBuilder methodsFor: 'accessing-metanodes' stamp: 'jk 8/26/2007 16:54'! root ^ root! ! !OBMetagraphBuilder methodsFor: 'accessing-metanodes' stamp: 'dc 9/7/2007 11:56'! root: rootMetaNode root := rootMetaNode. self addMetaNode: rootMetaNode! ! !OBMetagraphBuilder methodsFor: 'accessing' stamp: 'jk 8/26/2007 17:58'! selectorAt: aSelector ^ self selectors at: aSelector! ! !OBMetagraphBuilder methodsFor: 'accessing' stamp: 'jk 8/26/2007 17:59'! selectorAt: aKey put: aValue ^ self selectors at: aKey put: aValue! ! !OBMetagraphBuilder methodsFor: 'accessing' stamp: 'lr 8/13/2010 16:36'! selectors ^ selectors ifNil: [ selectors := Dictionary new ]! ! !OBMetagraphBuilder methodsFor: 'initialization' stamp: 'lr 4/23/2010 08:39'! setRoot: rootNode classSel: classSelector commentSel: commentSelector metaclassSel: metaclassSelector self root: rootNode. self classSelector: classSelector. self commentSelector: commentSelector. self metaclassSelector: metaclassSelector! ! Object subclass: #OBMethodVersion instanceVariableNames: 'sources pointer classRef category stamp prior selector' classVariableNames: '' poolDictionaries: '' category: 'OB-Standard-Utilities'! !OBMethodVersion commentStamp: 'cwp 1/8/2005 13:25' prior: 0! OBMethodVerison represents a version of a method found in the .sources or .changes files. It provides methods for parsing the method definition referenced by a source pointer, and for filing in the source to replace the current version of the method.! !OBMethodVersion class methodsFor: 'instance creation' stamp: ''! fromSources: sources andPointer: pointer ^ self new setSources: sources pointer: pointer! ! !OBMethodVersion class methodsFor: 'scanning' stamp: 'PDC 6/29/2007 06:55'! scan: sources from: pointer | versions current | versions := OrderedCollection new. current := self fromSources: sources andPointer: pointer. [current notNil] whileTrue: [versions add: current. current := current previous]. ^ versions! ! !OBMethodVersion class methodsFor: 'scanning' stamp: ''! versionsOfMethod: methodReference | class selector | class := methodReference actualClass. selector := methodReference methodSymbol. ^ self scan: SourceFiles from: (class compiledMethodAt: selector) sourcePointer! ! !OBMethodVersion methodsFor: 'comparing' stamp: 'cwp 10/17/2004 23:45'! = other ^ self species = other species and: [self pointer = other pointer]! ! !OBMethodVersion methodsFor: 'accessing' stamp: ''! category ^ category! ! !OBMethodVersion methodsFor: 'accessing' stamp: ''! classSymbol ^ classRef name! ! !OBMethodVersion methodsFor: 'compiling' stamp: 'lr 3/12/2010 10:30'! fileIn self fileIn: self theClass! ! !OBMethodVersion methodsFor: 'compiling' stamp: 'lr 3/12/2010 10:31'! fileIn: aClass aClass isNil ifTrue: [ ^ self ]. aClass compile: self source classified: self category withStamp: self stamp notifying: nil! ! !OBMethodVersion methodsFor: 'comparing' stamp: 'cwp 10/17/2004 23:45'! hash ^ pointer hash! ! !OBMethodVersion methodsFor: 'accessing' stamp: 'cwp 10/17/2004 23:51'! latest ^ self class fromSources: sources andPointer: (classRef theClass compiledMethodAt: selector) sourcePointer! ! !OBMethodVersion methodsFor: 'initializing' stamp: 'cwp 11/6/2004 23:14'! parseChunk: aString | tokens | tokens := Scanner new scanTokens: aString. classRef := OBClassReference named: tokens first. tokens second = #class ifTrue: [classRef beMeta. category := tokens fourth. stamp := tokens sixth] ifFalse: [category := tokens third. tokens size > 3 ifTrue: [stamp := tokens fifth]]. tokens size > 6 ifTrue: [prior := tokens last].! ! !OBMethodVersion methodsFor: 'initializing' stamp: 'PDC 6/25/2007 21:58'! parseSource | file position chunk | file := sources at: (sources fileIndexFromSourcePointer: pointer). position := sources filePositionFromSourcePointer: pointer. chunk := ''. position > file size ifTrue: [self error: 'Invalid source pointer']. file position: (0 max: position-150). "Skip back to before the preamble" [file position < (position-1)] "then pick it up from the front" whileTrue: [chunk := file nextChunk]. self parseChunk: chunk.! ! !OBMethodVersion methodsFor: 'accessing' stamp: 'cwp 10/17/2004 23:42'! pointer ^ pointer! ! !OBMethodVersion methodsFor: 'initializing' stamp: 'dr 12/13/2008 17:37'! previous ^(prior notNil and: [prior > 0]) ifTrue: [self class fromSources: sources andPointer: prior]! ! !OBMethodVersion methodsFor: 'accessing' stamp: ''! selector ^ selector ifNil: [self setSelector]! ! !OBMethodVersion methodsFor: 'initializing' stamp: ''! setSelector | file | file := sources at: (sources fileIndexFromSourcePointer: pointer). file position: (sources filePositionFromSourcePointer: pointer). ^ selector := Parser new parseSelector: file nextChunk.! ! !OBMethodVersion methodsFor: 'initializing' stamp: ''! setSources: aSourceFileArray pointer: aSourcePointer sources := aSourceFileArray. pointer := aSourcePointer. self parseSource.! ! !OBMethodVersion methodsFor: 'accessing' stamp: ''! source | file | file := sources at: (sources fileIndexFromSourcePointer: pointer). file position: (sources filePositionFromSourcePointer: pointer). ^ file nextChunk asText makeSelectorBold! ! !OBMethodVersion methodsFor: 'accessing' stamp: ''! stamp ^ stamp! ! !OBMethodVersion methodsFor: 'accessing' stamp: ''! theClass ^ classRef theClass! ! !OBMethodVersion methodsFor: 'accessing' stamp: ''! theClassName ^ classRef name! ! Object subclass: #OBSystemBrowserAdaptor instanceVariableNames: 'class selector' classVariableNames: '' poolDictionaries: '' category: 'OB-Standard-Utilities'! !OBSystemBrowserAdaptor commentStamp: 'cwp 1/8/2005 13:35' prior: 0! OBSystemBrowserAdaptor implements the protocol expected by the SystemBrowser app registry, and thus allows OmniBrowser to be chosen as the default system browser. Caveat: because the required protocol is a little ...odd.... it can't be implemented well by OBSystemBrowser directly. OBSystemBrowserAdaptor does this reasonably well, but it has no way to provide a more natural name than its class name to the app registry menu.! !OBSystemBrowserAdaptor class methodsFor: 'configuration' stamp: 'lr 7/2/2011 16:19'! browserClass ^ OBSystemBrowser! ! !OBSystemBrowserAdaptor class methodsFor: 'public' stamp: 'lr 7/2/2011 16:20'! fullOnClass: aClass ^ self browserClass openOnClass: aClass! ! !OBSystemBrowserAdaptor class methodsFor: 'public' stamp: 'lr 7/2/2011 16:20'! fullOnClass: aClass selector: aSelector ^ self browserClass openOnClass: aClass selector: aSelector! ! !OBSystemBrowserAdaptor class methodsFor: 'initializing' stamp: 'cwp 12/5/2004 22:01'! initialize self register! ! !OBSystemBrowserAdaptor class methodsFor: 'configuration' stamp: 'cwp 9/28/2009 09:21'! nameForViewer ^ 'OmniBrowser'! ! !OBSystemBrowserAdaptor class methodsFor: 'public' stamp: 'lr 7/2/2011 16:22'! newOnClass: aClass ^ self browserClass openOnClass: aClass! ! !OBSystemBrowserAdaptor class methodsFor: 'public' stamp: 'lr 7/2/2011 16:29'! newOnClass: aClass label: aString ^ self browserClass openOnClass: aClass! ! !OBSystemBrowserAdaptor class methodsFor: 'public' stamp: 'lr 7/2/2011 16:23'! newOnClass: aClass selector: aSymbol ^ self browserClass openOnClass: aClass selector: aSymbol! ! !OBSystemBrowserAdaptor class methodsFor: 'public' stamp: 'lr 4/9/2011 09:27'! open ^ self browserClass open! ! !OBSystemBrowserAdaptor class methodsFor: 'public' stamp: 'lr 4/9/2011 09:27'! openBrowser ^ self browserClass open! ! !OBSystemBrowserAdaptor class methodsFor: 'public' stamp: 'dr 7/19/2007 16:35'! openBrowserView: adaptor label: ignored ^ self browserClass openOnClass: adaptor targetClass selector: adaptor selector! ! !OBSystemBrowserAdaptor class methodsFor: 'initializing' stamp: 'lr 7/2/2011 16:19'! register Smalltalk at: #SystemBrowser ifPresent: [ :class | class register: self ]! ! !OBSystemBrowserAdaptor class methodsFor: 'initializing' stamp: 'cwp 9/28/2009 01:25'! unload self unregister! ! !OBSystemBrowserAdaptor class methodsFor: 'initializing' stamp: 'lr 7/2/2011 16:19'! unregister Smalltalk at: #SystemBrowser ifPresent: [ :class | class unregister: self ]! ! !OBSystemBrowserAdaptor methodsFor: 'registry protocol' stamp: 'cwp 12/5/2004 21:50'! labelString ^ 'System Browser'! ! !OBSystemBrowserAdaptor methodsFor: 'registry protocol' stamp: 'cwp 12/5/2004 21:49'! openEditString: anUndefinedObject ^ self! ! !OBSystemBrowserAdaptor methodsFor: 'accessing' stamp: 'cwp 12/5/2004 21:55'! selector ^ selector! ! !OBSystemBrowserAdaptor methodsFor: 'registry protocol' stamp: 'cwp 12/5/2004 21:49'! setClass: aClass selector: aSelector class := aClass. selector := aSelector! ! !OBSystemBrowserAdaptor methodsFor: 'actions' stamp: 'dc 4/24/2007 15:09'! spawnHierarchy ^ OBHierarchyBrowser openOnClass: self targetClass ! ! !OBSystemBrowserAdaptor methodsFor: 'accessing' stamp: 'dr 4/24/2007 18:05'! targetClass ^class! ! OBCommand subclass: #OBCategoryCommand instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'OB-Standard-Commands'! !OBCategoryCommand methodsFor: 'accessing' stamp: 'avi 5/30/2007 23:07'! group ^ #category! ! !OBCategoryCommand methodsFor: 'testing' stamp: 'lr 11/8/2009 10:02'! isActive ^ target hasOrganization and: [ (requestor isSelected: target) not ]! ! OBCategoryCommand subclass: #OBCmdCreateCategory instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'OB-Standard-Commands'! !OBCmdCreateCategory methodsFor: 'accessing' stamp: 'lr 9/22/2010 21:09'! categories ^ self subclassResponsibility! ! !OBCmdCreateCategory methodsFor: 'execution' stamp: 'lr 12/9/2011 21:58'! execute | categories category before node | categories := self categories sorted. category := OBCompletionRequest new assisted: true; collection: categories; prompt: 'Add Category'; signal. category isNil ifTrue: [ ^ self ]. before := requestor children at: requestor selection + 1 ifAbsent: [ nil ]. target organization addCategory: category before: (before isNil ifFalse: [ before name ]). (target categoryNodeNamed: category) announceCreationWith: requestor announcer! ! !OBCmdCreateCategory methodsFor: 'accessing' stamp: 'lr 9/22/2010 21:07'! icon ^ #newIcon! ! !OBCmdCreateCategory methodsFor: 'accessing' stamp: 'lr 9/25/2010 22:28'! label ^ 'Add category...'! ! OBCmdCreateCategory subclass: #OBCmdCreateClassCategory instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'OB-Standard-Commands'! !OBCmdCreateClassCategory methodsFor: 'accessing' stamp: 'lr 9/24/2010 08:06'! categories | categories | categories := Set new. PackageOrganizer default packages do: [ :package | categories add: package systemCategoryPrefix ]. target categories do: [ :node | categories add: node name ]. ^ categories! ! !OBCmdCreateClassCategory methodsFor: 'testing' stamp: 'lr 5/14/2011 09:32'! isActive ^ super isActive and: [ (target isKindOf: OBClassCategoryNode) or: [ target isKindOf: OBEnvironmentNode ] ]! ! OBCmdCreateCategory subclass: #OBCmdCreateMethodCategory instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'OB-Standard-Commands'! !OBCmdCreateMethodCategory methodsFor: 'accessing' stamp: 'lr 9/24/2010 08:07'! categories | categories | categories := Set new. target theClass withAllSuperclasses do: [ :class | class organization categories do: [ :each | categories add: each asLowercase ] ]. PackageOrganizer default packages do: [ :package | categories add: package methodCategoryPrefix ]. categories remove: ClassOrganizer nullCategory ifAbsent: [ ]; remove: ClassOrganizer default ifAbsent: [ ]. ^ categories! ! !OBCmdCreateMethodCategory methodsFor: 'testing' stamp: 'lr 11/8/2009 10:03'! isActive ^ super isActive and: [ requestor selectedNode isKindOf: OBMethodCategoryNode ]! ! OBCategoryCommand subclass: #OBCmdRemoveEmptyCats instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'OB-Standard-Commands'! !OBCmdRemoveEmptyCats methodsFor: 'execution' stamp: 'lr 6/21/2009 17:07'! execute target organization removeEmptyCategories. requestor browser announce: OBRefreshRequired! ! !OBCmdRemoveEmptyCats methodsFor: 'accessing' stamp: 'lr 8/8/2010 10:07'! label ^ 'Remove empty categories'! ! OBCategoryCommand subclass: #OBCmdRenameCategory instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'OB-Standard-Commands'! !OBCmdRenameCategory methodsFor: 'accessing' stamp: 'lr 9/22/2010 21:18'! categories ^ self subclassResponsibility! ! !OBCmdRenameCategory methodsFor: 'execution' stamp: 'lr 12/9/2011 22:00'! execute | categories category | categories := self categories sorted. category := OBCompletionRequest new assisted: true; default: target name; collection: categories; prompt: 'Rename Category'; signal. category isNil ifTrue: [ ^ self ]. target renameTo: category; setName: category. target announceChangedWith: requestor announcer! ! !OBCmdRenameCategory methodsFor: 'testing' stamp: 'lr 9/22/2010 21:28'! isActive ^ requestor isSelected: target! ! !OBCmdRenameCategory methodsFor: 'accessing' stamp: 'lr 8/8/2010 10:07'! label ^ 'Rename category...'! ! OBCmdRenameCategory subclass: #OBCmdRenameClassCategory instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'OB-Standard-Commands'! !OBCmdRenameClassCategory methodsFor: 'accessing' stamp: 'lr 9/22/2010 22:11'! categories ^ requestor parent categories collect: [ :each | each name ]! ! !OBCmdRenameClassCategory methodsFor: 'testing' stamp: 'lr 9/22/2010 21:29'! isActive ^ super isActive and: [ target isKindOf: OBClassCategoryNode ]! ! OBCmdRenameCategory subclass: #OBCmdRenameMethodCategory instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'OB-Standard-Commands'! !OBCmdRenameMethodCategory methodsFor: 'accessing' stamp: 'lr 9/22/2010 21:39'! categories | categories | categories := Set new. target theClass allSuperclasses do: [ :each | categories addAll: each organization categories ]. PackageOrganizer default packages do: [ :each | categories add: each methodCategoryPrefix ]. target theClass organization categories do: [ :each | categories remove: each ifAbsent: [ ] ]. categories remove: ClassOrganizer nullCategory ifAbsent: [ ]; remove: ClassOrganizer default ifAbsent: [ ]. ^ categories! ! !OBCmdRenameMethodCategory methodsFor: 'testing' stamp: 'lr 9/22/2010 21:29'! isActive ^ super isActive and: [ (target isKindOf: OBMethodCategoryNode) and: [ (target isKindOf: OBAllMethodCategoryNode) not ] ]! ! OBCategoryCommand subclass: #OBCmdReorgCats instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'OB-Standard-Commands'! !OBCmdReorgCats methodsFor: 'execution' stamp: 'cwp 10/15/2006 18:53'! execute | definition organizer | organizer := target organization. definition := OBOrganizationDefinition on: organizer. requestor announce: definition! ! !OBCmdReorgCats methodsFor: 'accessing' stamp: 'lr 8/8/2010 10:07'! label ^ 'Reorganize categories'! ! OBCommand subclass: #OBCmdAutoCategorize instanceVariableNames: '' classVariableNames: 'CategorizationRules IgnoredCategories' poolDictionaries: '' category: 'OB-Standard-Commands'! !OBCmdAutoCategorize class methodsFor: 'private' stamp: 'lr 9/22/2010 09:07'! commonProtocolFor: aSelector in: aClass | protocols protocol | protocols := Bag new. self environment allClassesAndTraitsDo: [ :behavior | | class | class := aClass isMeta ifTrue: [ behavior theMetaClass ] ifFalse: [ behavior theNonMetaClass ]. (class includesSelector: aSelector) ifTrue: [ protocol := class organization categoryOfElement: aSelector. (self isValidProtocol: protocol) ifTrue: [ protocols add: protocol ] ] ]. protocols isEmpty ifTrue: [ ^ nil ]. protocol := protocols sortedCounts first. ^ protocol key >= 5 ifTrue: [ protocol value ]! ! !OBCmdAutoCategorize class methodsFor: 'initialization' stamp: 'lr 12/1/2010 19:01'! initialize IgnoredCategories := Array with: Categorizer default with: Categorizer allCategory with: Categorizer nullCategory. CategorizationRules := OrderedCollection new. CategorizationRules add: [ :class :selector | self superclassProtocolFor: selector in: class ]; add: [ :class :selector | (selector beginsWith: 'add') ifTrue: [ #adding ] ]; add: [ :class :selector | (selector beginsWith: 'as') ifTrue: [ #converting ] ]; add: [ :class :selector | (selector beginsWith: 'accept') ifTrue: [ #visiting ] ]; add: [ :class :selector | (selector beginsWith: 'remove') ifTrue: [ #removing ] ]; add: [ :class :selector | (selector beginsWith: 'render') ifTrue: [ #rendering ] ]; add: [ :class :selector | (selector beginsWith: 'initialize') ifTrue: [ #initialization ] ]; add: [ :class :selector | ((selector beginsWith: 'is') or: [ selector beginsWith: 'has' ]) ifTrue: [ #testing ] ]; add: [ :class :selector | ((class includesBehavior: TestCase) and: [ selector beginsWith: 'test' ]) ifTrue: [ #tests ] ]; add: [ :class :selector | ((selector beginsWith: 'basic') or: [ (selector beginsWith: 'private') or: [ selector beginsWith: 'primitive' ] ]) ifTrue: [ #private ] ]; add: [ :class :selector | (class isMeta and: [ (selector beginsWith: 'new') or: [ (selector beginsWith: 'on') or: [ selector beginsWith: 'with' ] ] ]) ifTrue: [ #'instance creation' ] ]; add: [ :class :selector | ((selector numArgs = 0 and: [ class allInstVarNames includes: selector asString ]) or: [ selector numArgs = 1 and: [ class allInstVarNames includes: selector asString allButLast ] ]) ifTrue: [ #accessing ] ]; add: [ :class :selector | self commonProtocolFor: selector in: class ]! ! !OBCmdAutoCategorize class methodsFor: 'testing' stamp: 'lr 9/22/2010 08:55'! isValidProtocol: aSymbol ^ aSymbol notNil and: [ (aSymbol beginsWith: '*') not and: [ (IgnoredCategories includes: aSymbol) not ] ]! ! !OBCmdAutoCategorize class methodsFor: 'private' stamp: 'lr 9/22/2010 09:08'! superclassProtocolFor: aSelector in: aClass aClass allSuperclassesDo: [ :class | | protocol | protocol := class organization categoryOfElement: aSelector. (self isValidProtocol: protocol) ifTrue: [ ^ protocol ]. class theNonMetaClass = ProtoObject ifTrue: [ ^ nil ] ]. ^ nil! ! !OBCmdAutoCategorize methodsFor: 'execution' stamp: 'lr 9/22/2010 08:52'! categorize: aSelector CategorizationRules do: [ :rule | | result | result := rule value: target theClass value: aSelector. result isNil ifFalse: [ ^ self organization classify: aSelector under: result ] ]! ! !OBCmdAutoCategorize methodsFor: 'execution' stamp: 'lr 8/17/2010 18:33'! execute (self organization listAtCategoryNamed: ClassOrganizer default) do: [ :each | self categorize: each ]! ! !OBCmdAutoCategorize methodsFor: 'accessing' stamp: 'cwp 10/9/2006 15:07'! group ^ #category! ! !OBCmdAutoCategorize methodsFor: 'testing' stamp: 'lr 9/22/2010 08:57'! isActive ^ target hasOrganization and: [ target organization isClassOrganizer and: [ (requestor isSelected: target) not ] ]! ! !OBCmdAutoCategorize methodsFor: 'accessing' stamp: 'lr 8/8/2010 10:07'! label ^ 'Categorize automatically'! ! !OBCmdAutoCategorize methodsFor: 'accessing' stamp: 'lr 8/17/2010 18:33'! organization ^ target organization! ! OBCommand subclass: #OBCmdBrowse instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'OB-Standard-Commands'! !OBCmdBrowse methodsFor: 'execution' stamp: 'dr 9/5/2008 11:23'! execute target browse! ! !OBCmdBrowse methodsFor: 'accessing' stamp: 'cwp 10/9/2006 17:56'! group ^ #navigation! ! !OBCmdBrowse methodsFor: 'testing' stamp: 'lr 3/13/2010 12:09'! isActive ^ (requestor isSelected: target) and: [ target isBrowsable ]! ! !OBCmdBrowse methodsFor: 'accessing' stamp: 'cwp 10/9/2006 15:18'! keystroke ^ $b! ! !OBCmdBrowse methodsFor: 'accessing' stamp: 'lr 8/8/2010 10:07'! label ^ 'Browse'! ! !OBCmdBrowse methodsFor: 'accessing' stamp: 'lr 11/17/2011 00:11'! longDescription ^ 'Open a new browser on the current element.'! ! OBCommand subclass: #OBCmdBrowseHierarchy instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'OB-Standard-Commands'! !OBCmdBrowseHierarchy methodsFor: 'accessing' stamp: 'lr 8/8/2010 10:14'! buttonLabel ^ 'Hierarchy'! ! !OBCmdBrowseHierarchy methodsFor: 'execution' stamp: 'lr 4/3/2009 13:44'! execute target browseHierarchy! ! !OBCmdBrowseHierarchy methodsFor: 'accessing' stamp: 'cwp 10/11/2006 00:17'! group ^ #navigation! ! !OBCmdBrowseHierarchy methodsFor: 'testing' stamp: 'lr 6/12/2010 15:13'! isActive ^ (requestor isSelected: target) and: [ (target isKindOf: OBClassAwareNode) and: [ target theClass isTrait not ] ]! ! !OBCmdBrowseHierarchy methodsFor: 'accessing' stamp: 'dc. 12/15/2007 15:46'! keystroke ^ $h! ! !OBCmdBrowseHierarchy methodsFor: 'accessing' stamp: 'lr 8/8/2010 10:07'! label ^ 'Browse hierarchy'! ! !OBCmdBrowseHierarchy methodsFor: 'accessing' stamp: 'lr 11/17/2011 00:11'! longDescription ^ 'Browse the hierarchy of the class.'! ! OBCommand subclass: #OBCmdBrowseImplementorsOfIt instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'OB-Standard-Commands'! !OBCmdBrowseImplementorsOfIt class methodsFor: 'testing' stamp: 'cwp 10/16/2006 22:13'! takesNodes ^ false! ! !OBCmdBrowseImplementorsOfIt class methodsFor: 'testing' stamp: 'cwp 10/16/2006 22:01'! takesText ^ true! ! !OBCmdBrowseImplementorsOfIt methodsFor: 'execution' stamp: 'cwp 8/24/2007 01:34'! execute | node | node := OBSelectorNode on: target selector. (requestor announce: (OBShowImplementors of: node)) execute! ! !OBCmdBrowseImplementorsOfIt methodsFor: 'testing' stamp: 'cwp 10/16/2006 21:32'! isActive ^ true! ! !OBCmdBrowseImplementorsOfIt methodsFor: 'testing' stamp: 'cwp 10/16/2006 23:14'! isEnabled ^ target hasSelector! ! !OBCmdBrowseImplementorsOfIt methodsFor: 'accessing' stamp: 'cwp 3/11/2007 19:53'! keystroke ^ $m! ! !OBCmdBrowseImplementorsOfIt methodsFor: 'accessing' stamp: 'lr 8/8/2010 10:07'! label ^ 'Implementors'! ! OBCommand subclass: #OBCmdBrowseInheritance instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'OB-Standard-Commands'! !OBCmdBrowseInheritance methodsFor: 'execution' stamp: 'cwp 10/17/2006 21:28'! execute OBInheritanceBrowser openRoot: target inheritanceRoot selection: target! ! !OBCmdBrowseInheritance methodsFor: 'accessing' stamp: 'cwp 10/17/2006 21:30'! group ^ #navigation! ! !OBCmdBrowseInheritance methodsFor: 'testing' stamp: 'lr 3/13/2010 17:05'! isActive ^ (requestor isSelected: target) and: [ target hasSelector ]! ! !OBCmdBrowseInheritance methodsFor: 'accessing' stamp: 'lr 8/8/2010 10:07'! label ^ 'Inheritance'! ! OBCommand subclass: #OBCmdBrowseList instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'OB-Standard-Commands'! OBCmdBrowseList subclass: #OBCmdBrowseHierarchyImplementors instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'OB-Standard-Commands'! !OBCmdBrowseHierarchyImplementors methodsFor: 'configuration' stamp: 'dr 9/21/2007 11:22'! announcementClass ^ OBShowHierarchyImplementors! ! !OBCmdBrowseHierarchyImplementors methodsFor: 'command' stamp: 'lr 9/1/2011 21:28'! label ^ 'Implementors in hierarchy...'! ! OBCmdBrowseList subclass: #OBCmdBrowseHierarchySenders instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'OB-Standard-Commands'! !OBCmdBrowseHierarchySenders methodsFor: 'configuration' stamp: 'dr 9/21/2007 11:22'! announcementClass ^ OBShowHierarchySenders! ! !OBCmdBrowseHierarchySenders methodsFor: 'command' stamp: 'lr 9/1/2011 21:28'! label ^ 'Senders in hierarchy...'! ! OBCmdBrowseList subclass: #OBCmdBrowseImplementors instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'OB-Standard-Commands'! !OBCmdBrowseImplementors methodsFor: 'configuration' stamp: 'cwp 8/20/2007 23:00'! announcementClass ^ OBShowImplementors! ! !OBCmdBrowseImplementors methodsFor: 'accessing' stamp: 'cwp 10/15/2006 21:13'! keystroke ^ $m! ! !OBCmdBrowseImplementors methodsFor: 'accessing' stamp: 'cwp 12/1/2011 17:19'! label ^ 'Implementors...'! ! !OBCmdBrowseImplementors methodsFor: 'accessing' stamp: 'lr 11/17/2011 00:12'! longDescription ^ 'Browse the implementors of this method.'! ! !OBCmdBrowseList class methodsFor: 'utilties' stamp: 'lr 10/20/2011 18:23'! selectSymbol: aString default: aSymbol proposed: anArray ^ self selectSymbol: aString default: aSymbol proposed: anArray assisted: false! ! !OBCmdBrowseList class methodsFor: 'utilties' stamp: 'lr 10/20/2011 18:23'! selectSymbol: aString default: aSymbol proposed: anArray assisted: aBoolean | systemSymbols | ^ OBCompletionRequest new assisted: aBoolean; prompt: aString; default: aSymbol; searchBlock: [ :value | (systemSymbols isNil and: [ aSymbol ~= value ]) ifTrue: [ systemSymbols := IdentitySet new. Smalltalk globals allClassesAndTraitsDo: [ :each | systemSymbols addAll: each selectors; addAll: each class selectors ]. systemSymbols := systemSymbols sorted ]. (systemSymbols isNil or: [ value isEmpty ]) ifTrue: [ anArray ] ifFalse: [ systemSymbols select: [ :each | OBCompletionRequest subsequence: value matches: each caseSensitive: false ] ] ]; signal! ! !OBCmdBrowseList methodsFor: 'accessing' stamp: 'lr 3/4/2009 22:07'! announcementClass self subclassResponsibility! ! !OBCmdBrowseList methodsFor: 'command' stamp: 'lr 9/1/2011 21:41'! execute | localSymbols systemSymbols symbol node | localSymbols := target selectorAndMessages collect: [ :each | each name ]. symbol := self class selectSymbol: 'Choose ' , (self label allButLast: 4) default: localSymbols first proposed: localSymbols. symbol ifNil: [ ^ self ]. node := OBMessageNode on: symbol asSymbol inMethod: symbol asSymbol inClass: target theClass. (requestor announce: (self announcementClass of: node)) execute! ! !OBCmdBrowseList methodsFor: 'command' stamp: 'dr 7/2/2007 15:12'! group ^ #navigation! ! !OBCmdBrowseList methodsFor: 'command' stamp: 'lr 3/13/2010 17:05'! isActive ^ (requestor isSelected: target) and: [ target hasSelector ]! ! OBCmdBrowseList subclass: #OBCmdBrowseSenders instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'OB-Standard-Commands'! !OBCmdBrowseSenders methodsFor: 'configuration' stamp: 'cwp 8/20/2007 23:00'! announcementClass ^ OBShowSenders! ! !OBCmdBrowseSenders methodsFor: 'command' stamp: 'cwp 10/11/2006 20:35'! keystroke ^ $n! ! !OBCmdBrowseSenders methodsFor: 'accessing' stamp: 'cwp 12/1/2011 17:19'! label ^ 'Senders...'! ! !OBCmdBrowseSenders methodsFor: 'accessing' stamp: 'lr 11/17/2011 00:12'! longDescription ^ 'Browse the senders of this method.'! ! OBCommand subclass: #OBCmdBrowseMethodVersions instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'OB-Standard-Commands'! !OBCmdBrowseMethodVersions methodsFor: 'execution' stamp: 'cwp 10/15/2006 18:49'! execute OBVersionBrowser openOn: target copy! ! !OBCmdBrowseMethodVersions methodsFor: 'accessing' stamp: 'cwp 10/9/2006 18:09'! group ^ #navigation! ! !OBCmdBrowseMethodVersions methodsFor: 'testing' stamp: 'lr 3/13/2010 17:05'! isActive ^ (requestor isSelected: target) and: [ target hasVersions ]! ! !OBCmdBrowseMethodVersions methodsFor: 'accessing' stamp: 'cwp 3/11/2007 19:53'! keystroke ^ $v! ! !OBCmdBrowseMethodVersions methodsFor: 'accessing' stamp: 'lr 8/8/2010 10:07'! label ^ 'Versions'! ! !OBCmdBrowseMethodVersions methodsFor: 'accessing' stamp: 'lr 11/17/2011 00:12'! longDescription ^ 'Display the different versions of this method.'! ! OBCommand subclass: #OBCmdBrowseReferences instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'OB-Standard-Commands'! !OBCmdBrowseReferences methodsFor: 'execution' stamp: 'cwp 12/7/2006 22:05'! execute OBReferencesBrowser browseRoot: target theNonMetaClass asNode! ! !OBCmdBrowseReferences methodsFor: 'accessing' stamp: 'cwp 12/7/2006 22:30'! group ^ #navigation! ! !OBCmdBrowseReferences methodsFor: 'testing' stamp: 'dc 8/2/2007 17:32'! isActive ^ (target isKindOf: OBClassAwareNode) and: [requestor isSelected: target]! ! !OBCmdBrowseReferences methodsFor: 'accessing' stamp: 'ben 8/3/2007 12:12'! keystroke ^ $N! ! !OBCmdBrowseReferences methodsFor: 'accessing' stamp: 'lr 8/8/2010 10:07'! label ^ 'Browse references'! ! OBCommand subclass: #OBCmdBrowseReferencesOfIt instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'OB-Standard-Commands'! !OBCmdBrowseReferencesOfIt class methodsFor: 'testing' stamp: 'lr 8/16/2010 10:44'! takesNodes ^ false! ! !OBCmdBrowseReferencesOfIt class methodsFor: 'testing' stamp: 'lr 8/16/2010 10:44'! takesText ^ true! ! !OBCmdBrowseReferencesOfIt methodsFor: 'execution' stamp: 'cwp 11/10/2011 23:20'! execute self globalReference ifNotNil: [:node | ^ OBReferencesBrowser browseRoot: node]. self localReference ifNotNil: [:node | ^ (OBVariablesBrowser browseRoot: node theClass asNode) jumpTo: node]! ! !OBCmdBrowseReferencesOfIt methodsFor: 'private' stamp: 'lr 7/13/2011 09:29'! globalReference | binding | target hasSelector ifFalse: [ ^ nil ]. ((binding := Smalltalk classNamed: target selector) notNil and: [ binding value notNil ]) ifTrue: [ ^ binding value asNode ]. ^ nil ! ! !OBCmdBrowseReferencesOfIt methodsFor: 'testing' stamp: 'lr 8/16/2010 10:44'! isActive ^ true! ! !OBCmdBrowseReferencesOfIt methodsFor: 'testing' stamp: 'lr 4/9/2011 17:48'! isEnabled ^ self globalReference notNil or: [ self localReference notNil ]! ! !OBCmdBrowseReferencesOfIt methodsFor: 'accessing' stamp: 'lr 8/16/2010 10:44'! keystroke ^ $N! ! !OBCmdBrowseReferencesOfIt methodsFor: 'accessing' stamp: 'lr 8/16/2010 11:09'! label ^ 'References'! ! !OBCmdBrowseReferencesOfIt methodsFor: 'private' stamp: 'lr 7/13/2011 09:27'! localReference | class | target hasSelector ifFalse: [ ^ nil ]. requestor selectedClass isNil ifTrue: [ ^ nil ]. " look for an instance variable: " class := requestor selectedClass whichClassDefinesInstVar: target selector. class isNil ifFalse: [ ^ OBInstanceVariableNode on: target selector inClass: class ]. " look for a class variable: " class := requestor selectedClass whichClassDefinesClassVar: target selector. class isNil ifFalse: [ ^ OBClassVariableNode on: target selector inClass: class ]. ^ nil! ! OBCommand subclass: #OBCmdBrowseSendersOfIt instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'OB-Standard-Commands'! !OBCmdBrowseSendersOfIt class methodsFor: 'testing' stamp: 'cwp 10/15/2006 01:00'! takesNodes ^ false! ! !OBCmdBrowseSendersOfIt class methodsFor: 'testing' stamp: 'cwp 10/15/2006 01:00'! takesText ^ true! ! !OBCmdBrowseSendersOfIt methodsFor: 'execution' stamp: 'lr 7/13/2011 09:30'! execute | node | node := OBSelectorNode on: target selector. (requestor announce: (OBShowSenders of: node)) execute! ! !OBCmdBrowseSendersOfIt methodsFor: 'testing' stamp: 'cwp 10/14/2006 21:06'! isActive ^ true! ! !OBCmdBrowseSendersOfIt methodsFor: 'testing' stamp: 'cwp 10/15/2006 19:31'! isEnabled ^ target hasSelector! ! !OBCmdBrowseSendersOfIt methodsFor: 'accessing' stamp: 'cwp 3/11/2007 19:57'! keystroke ^ $n! ! !OBCmdBrowseSendersOfIt methodsFor: 'accessing' stamp: 'lr 8/8/2010 10:07'! label ^ 'Senders'! ! OBCommand subclass: #OBCmdChaseVariables instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'OB-Standard-Commands'! !OBCmdChaseVariables methodsFor: 'accessing' stamp: 'lr 8/8/2010 10:14'! buttonLabel ^ 'Variables'! ! !OBCmdChaseVariables methodsFor: 'execution' stamp: 'cwp 10/15/2006 18:49'! execute ^ OBVariablesBrowser browseRoot: target classNode! ! !OBCmdChaseVariables methodsFor: 'accessing' stamp: 'cwp 10/10/2006 22:50'! group ^ #navigation! ! !OBCmdChaseVariables methodsFor: 'testing' stamp: 'dr 7/11/2008 11:23'! isActive ^ ((target isKindOf: OBClassAwareNode) or: [(target respondsTo: #theClass) and: [target theClass notNil]]) and: [requestor isSelected: target]! ! !OBCmdChaseVariables methodsFor: 'accessing' stamp: 'lr 8/8/2010 10:07'! label ^ 'Chase variables'! ! OBCommand subclass: #OBCmdClassTemplate instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'OB-Standard-Commands'! !OBCmdClassTemplate methodsFor: 'accessing' stamp: 'dc 7/16/2007 18:34'! currentCategory ^ target theNonMetaClass category! ! !OBCmdClassTemplate methodsFor: 'accessing' stamp: 'dc 7/16/2007 18:36'! currentClass ^ target theNonMetaClass! ! !OBCmdClassTemplate methodsFor: 'accessing' stamp: 'dc 7/16/2007 18:34'! currentEnvironment ^ target theNonMetaClass environment! ! !OBCmdClassTemplate methodsFor: 'execution' stamp: 'lr 3/4/2009 08:17'! execute | definition | definition := self templateDefinition. definition isNil ifFalse: [ requestor announce: (OBDefinitionChanged definition: definition) ]! ! !OBCmdClassTemplate methodsFor: 'accessing' stamp: 'lr 5/9/2011 18:49'! icon ^ #newIcon! ! !OBCmdClassTemplate methodsFor: 'testing' stamp: 'dc 7/22/2007 21:02'! isActive ^ (target isKindOf: OBClassNode) and: [requestor isSelected: target]! ! !OBCmdClassTemplate methodsFor: 'private' stamp: 'dc 7/16/2007 18:42'! templateDefinition self subclassResponsibility! ! OBCmdClassTemplate subclass: #OBCmdNewClassTemplate instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'OB-Standard-Commands'! !OBCmdNewClassTemplate methodsFor: 'execution' stamp: 'dc 4/23/2007 15:08'! execute | class definition | class := target theNonMetaClass. definition := (OBClassDefinition environment: class environment template: (Class template: class category)). requestor announce: (OBDefinitionChanged definition: definition)! ! !OBCmdNewClassTemplate methodsFor: 'accessing' stamp: 'lr 8/8/2010 10:07'! label ^ 'New class template'! ! !OBCmdNewClassTemplate methodsFor: 'private' stamp: 'dc 7/16/2007 18:42'! templateDefinition ^ OBClassDefinition environment: self currentEnvironment template: (Class template: self currentCategory)! ! OBCmdClassTemplate subclass: #OBCmdSubclassTemplate instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'OB-Standard-Commands'! !OBCmdSubclassTemplate methodsFor: 'accessing' stamp: 'lr 8/8/2010 10:07'! label ^ 'Subclass template'! ! !OBCmdSubclassTemplate methodsFor: 'private' stamp: 'dc 7/16/2007 18:42'! templateDefinition ^ OBClassDefinition environment: self currentEnvironment template: (Class templateForSubclassOf: self currentClass category: self currentCategory)! ! OBCommand subclass: #OBCmdCompareToCurrent instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'OB-Standard-Commands'! !OBCmdCompareToCurrent methodsFor: 'accessing' stamp: 'lr 8/8/2010 10:14'! buttonLabel ^ 'Compare to current'! ! !OBCmdCompareToCurrent methodsFor: 'execution' stamp: 'dr 12/16/2008 11:21'! execute | defPanel s1 s2 text current change | defPanel := requestor browser definitionPanel. current := target source. change := target version source. s1 := current string. s2 := change string. s1 = s2 ifTrue: [^ self inform: 'Exact Match' translated]. text := TextDiffBuilder buildDisplayPatchFrom: s1 to: s2 inClass: target theNonMetaClass prettyDiffs: false. defPanel definition: (OBTextDefinition text: text).! ! !OBCmdCompareToCurrent methodsFor: 'testing' stamp: 'dr 12/16/2008 10:28'! isActive ^ (target isKindOf: OBMethodVersionNode) and: [requestor isSelected: target]! ! !OBCmdCompareToCurrent methodsFor: 'accessing' stamp: 'dr 12/16/2008 10:28'! keystroke ^ $c! ! !OBCmdCompareToCurrent methodsFor: 'accessing' stamp: 'lr 8/8/2010 10:07'! label ^ 'Compare to current method'! ! !OBCmdCompareToCurrent methodsFor: 'accessing' stamp: 'lr 11/17/2011 00:12'! longDescription ^ 'Compare current method version to current selection.'! ! OBCommand subclass: #OBCmdCopyClass instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'OB-Standard-Commands'! !OBCmdCopyClass methodsFor: 'execution' stamp: 'cwp 12/3/2011 23:53'! copyClass: oldClass as: newName | oldDefinition newDefinition | (oldClass environment hasClassNamed: newName) ifTrue: [ ^ self error: newName , ' already exists' ]. oldDefinition := oldClass definition. newDefinition := oldDefinition copyReplaceAll: '#' , oldClass name asString with: '#' , newName asString. ^ Cursor wait showWhile: [| newClass | newClass := Compiler evaluate: newDefinition logged: true. newClass class copyInstVarNamesFrom: oldClass class. newClass copyAllCategoriesFrom: oldClass. newClass class copyAllCategoriesFrom: oldClass class. newClass]! ! !OBCmdCopyClass methodsFor: 'execution' stamp: 'lr 3/21/2009 20:03'! execute | newName newClass | newName := OBTextRequest prompt: 'Please type new class name' template: target theNonMetaClassName asString. newName isNil ifTrue: [ ^ self ]. newClass := self copyClass: target theNonMetaClass as: newName asSymbol. self select: newClass asNode with: requestor announcer! ! !OBCmdCopyClass methodsFor: 'accessing' stamp: 'cwp 11/2/2006 22:00'! group ^ #identity! ! !OBCmdCopyClass methodsFor: 'testing' stamp: 'cwp 11/2/2006 20:43'! isActive ^ (target isKindOf: OBClassNode) and: [requestor isSelected: target] ! ! !OBCmdCopyClass methodsFor: 'accessing' stamp: 'lr 8/8/2010 10:07'! label ^ 'Copy...'! ! OBCommand subclass: #OBCmdFileOut instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'OB-Standard-Commands'! !OBCmdFileOut methodsFor: 'execution' stamp: 'cwp 10/15/2006 18:50'! execute target fileOut! ! !OBCmdFileOut methodsFor: 'testing' stamp: 'cwp 10/9/2006 15:43'! isActive ^ (requestor isSelected: target) and: [target respondsTo: #fileOut]! ! !OBCmdFileOut methodsFor: 'accessing' stamp: 'dr 7/16/2008 11:13'! keystroke ^ $o! ! !OBCmdFileOut methodsFor: 'accessing' stamp: 'lr 8/8/2010 10:07'! label ^ 'File out'! ! OBCommand subclass: #OBCmdFindClass instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'OB-Standard-Commands'! !OBCmdFindClass methodsFor: 'execution' stamp: 'lr 9/22/2010 13:01'! execute | class | class := self requestClassToUser. class isNil ifFalse: [ self select: class asNode with: requestor announcer ]! ! !OBCmdFindClass methodsFor: 'private' stamp: 'lr 4/8/2011 19:39'! findClassIn: anEnvironment pattern: aString ^ (anEnvironment classNames select: [ :each | OBCompletionRequest subsequence: aString matches: each caseSensitive: false ]) asSortedCollection collect: [ :each | anEnvironment at: each ]! ! !OBCmdFindClass methodsFor: 'accessing' stamp: 'lr 9/22/2010 13:01'! group ^ #class! ! !OBCmdFindClass methodsFor: 'accessing' stamp: 'lr 9/22/2010 13:01'! icon ^ #findIcon! ! !OBCmdFindClass methodsFor: 'testing' stamp: 'lr 9/22/2010 13:03'! isActive ^ target isEnvironmentNode! ! !OBCmdFindClass methodsFor: 'accessing' stamp: 'cwp 10/9/2006 13:39'! keystroke ^ $f! ! !OBCmdFindClass methodsFor: 'accessing' stamp: 'lr 8/8/2010 10:07'! label ^ 'Find class...'! ! !OBCmdFindClass methodsFor: 'private' stamp: 'lr 9/22/2010 20:12'! requestClassToUser ^ OBCompletionRequest new prompt: 'Find Class'; searchBlock: [ :string | self findClassIn: target environment pattern: string ]; labelBlock: [ :class | class name ]; iconBlock: [ :class | class browserIcon ]; signal! ! OBCommand subclass: #OBCmdFindMethod instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'OB-Standard-Commands'! !OBCmdFindMethod methodsFor: 'private' stamp: 'lr 4/23/2010 08:37'! chooseSelector | selectors | selectors := target theClass selectors asArray sort. ^ selectors isEmpty ifFalse: [ OBChoiceRequest labels: selectors ]! ! !OBCmdFindMethod methodsFor: 'execution' stamp: 'dc 7/15/2007 16:31'! execute | selection method | selection := self chooseSelector. selection ifNotNil: [method := OBMethodNode on: selection inClass: target theClass. self select: method with: requestor announcer]! ! !OBCmdFindMethod methodsFor: 'accessing' stamp: 'cwp 6/8/2007 20:37'! icon ^ #findIcon! ! !OBCmdFindMethod methodsFor: 'testing' stamp: 'dr 1/9/2008 14:13'! isActive ^ (target isKindOf: OBClassNode) and: [requestor isSelected: target]! ! !OBCmdFindMethod methodsFor: 'accessing' stamp: 'lr 8/8/2010 10:07'! label ^ 'Find method...'! ! OBCommand subclass: #OBCmdMultiView instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'OB-Standard-Commands'! !OBCmdMultiView methodsFor: 'accessing' stamp: 'lr 1/28/2010 15:42'! compiledMethod ^ target theClass compiledMethodAt: target selector! ! !OBCmdMultiView methodsFor: 'accessing' stamp: 'lr 1/28/2010 15:35'! definition: aDefinition (requestor announce: OBAboutToChange) isVetoed ifFalse: [ requestor announce: (OBDefinitionChanged definition: aDefinition) ]! ! !OBCmdMultiView methodsFor: 'execution' stamp: 'lr 1/28/2010 15:41'! execute | viewType | viewType := OBChoiceRequest prompt: nil labels: #('source' 'pretty print' 'decompile' 'byte codes' ) values: #(showSource showPrettyPrint showDecompile showByteCodes). viewType isNil ifFalse: [ self perform: viewType ]! ! !OBCmdMultiView methodsFor: 'testing' stamp: 'lr 1/28/2010 15:44'! isActive ^ (target isKindOf: OBMethodNode) and: [ requestor isSelected: target ] ! ! !OBCmdMultiView methodsFor: 'testing' stamp: 'lr 8/8/2010 10:07'! label ^ 'View'! ! !OBCmdMultiView methodsFor: 'accessing' stamp: 'lr 11/17/2011 00:13'! longDescription ^ 'Displays different views of the current method.'! ! !OBCmdMultiView methodsFor: 'actions' stamp: 'lr 1/28/2010 15:42'! showByteCodes self definition: (OBTextDefinition text: self compiledMethod symbolic)! ! !OBCmdMultiView methodsFor: 'actions' stamp: 'lr 1/28/2010 15:41'! showDecompile self definition: (OBMethodDefinition source: self compiledMethod decompileString inClass: target theClass)! ! !OBCmdMultiView methodsFor: 'actions' stamp: 'lr 1/28/2010 15:41'! showPrettyPrint self definition: (OBMethodDefinition source: (target theClass compilerClass format: target source in: target theClass notifying: nil) inClass: target theClass)! ! !OBCmdMultiView methodsFor: 'actions' stamp: 'lr 1/28/2010 15:41'! showSource self definition: target definition! ! !OBCmdMultiView methodsFor: 'testing' stamp: 'lr 8/8/2010 10:48'! wantsMenu ^ false! ! OBCommand subclass: #OBCmdRemoveCat instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'OB-Standard-Commands'! !OBCmdRemoveCat methodsFor: 'execution' stamp: 'lr 11/26/2010 00:01'! execute | list choice | list := target container organization listAtCategoryNamed: target name. list isEmpty ifTrue: [ ^ target remove; announceDeletionWith: requestor announcer ]. choice := OBConfirmationRequest prompt: 'Are you sure you want to remove this category and all its elements?' confirm: 'Remove'. (choice notNil and: [ choice ]) ifTrue: [ ^ target remove; announceDeletionWith: requestor announcer ]! ! !OBCmdRemoveCat methodsFor: 'accessing' stamp: 'lr 6/9/2007 09:59'! icon ^ #deleteIcon! ! !OBCmdRemoveCat methodsFor: 'testing' stamp: 'dr 10/30/2008 09:54'! isActive ^ target isCategoryNode and: [requestor isSelected: target]! ! !OBCmdRemoveCat methodsFor: 'accessing' stamp: 'cwp 9/28/2006 08:37'! keystroke ^ $x! ! !OBCmdRemoveCat methodsFor: 'accessing' stamp: 'lr 8/8/2010 10:07'! label ^ 'Remove category...'! ! OBCommand subclass: #OBCmdRemoveClass instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'OB-Standard-Commands'! !OBCmdRemoveClass methodsFor: 'execution' stamp: 'lr 11/25/2010 23:40'! doRemove target theNonMetaClass removeFromSystem. target announceDeletionWith: requestor announcer! ! !OBCmdRemoveClass methodsFor: 'execution' stamp: 'lr 11/25/2010 23:55'! execute (OBConfirmationRequest prompt: 'Are you certain that you want to remove the class ' , target theNonMetaClassName , ' from the system?' confirm: 'Remove') ifFalse: [ ^ self ]. self doRemove! ! !OBCmdRemoveClass methodsFor: 'accessing' stamp: 'cwp 11/3/2006 00:15'! group ^ #identity! ! !OBCmdRemoveClass methodsFor: 'accessing' stamp: 'cwp 6/8/2007 20:37'! icon ^ #deleteIcon! ! !OBCmdRemoveClass methodsFor: 'testing' stamp: 'dr 9/30/2008 11:25'! isActive ^ (target isKindOf: OBClassNode) and: [requestor isSelected: target]! ! !OBCmdRemoveClass methodsFor: 'accessing' stamp: 'cwp 11/3/2006 00:17'! keystroke ^ $x! ! !OBCmdRemoveClass methodsFor: 'accessing' stamp: 'lr 8/8/2010 10:07'! label ^ 'Remove class...'! ! OBCommand subclass: #OBCmdRemoveElement instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'OB-Standard-Commands'! !OBCmdRemoveElement methodsFor: 'execution' stamp: 'cwp 11/10/2011 22:48'! execute target removeChild: requestor selectedNode. requestor refresh.! ! !OBCmdRemoveElement methodsFor: 'accessing' stamp: 'lr 5/9/2011 18:49'! icon ^ #deleteIcon! ! !OBCmdRemoveElement methodsFor: 'testing' stamp: 'cwp 7/20/2007 22:11'! isActive ^ (target isKindOf: OBCollectionNode) and: [requestor hasSelection]! ! !OBCmdRemoveElement methodsFor: 'accessing' stamp: 'lr 8/8/2010 10:07'! label ^ 'Remove element'! ! OBCommand subclass: #OBCmdRemoveMethod instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'OB-Standard-Commands'! !OBCmdRemoveMethod methodsFor: 'private' stamp: 'lr 3/10/2010 11:17'! browseSenders OBSendersBrowser browseRoot: target copy! ! !OBCmdRemoveMethod methodsFor: 'private' stamp: 'lr 2/7/2010 11:23'! doRemove | methods idxToBeRemoved method | methods := OrderedCollection new. requestor previous isNil ifFalse: [ | selectedNode | selectedNode := requestor previous selectedNode. (selectedNode isClassNode or: [ selectedNode isMethodCategoryNode ]) ifTrue: [ methods := selectedNode methods. idxToBeRemoved := methods indexOf: target ] ]. target theClass removeSelector: target selector. requestor announce: (OBNodeDeleted node: target). methods size > 1 ifFalse: [ ^ self ]. method := methods at: idxToBeRemoved + 1 ifAbsent: [ methods at: idxToBeRemoved - 1 ]. self select: method with: requestor announcer! ! !OBCmdRemoveMethod methodsFor: 'execution' stamp: 'lr 3/4/2009 08:17'! execute | senders choice | senders := SystemNavigation default allCallsOn: target selector. senders isEmpty ifTrue: [ ^ self doRemove ]. choice := OBChoiceRequest prompt: 'This message has ' , senders size asString , ' senders.' labels: #( 'Remove it' 'Remove, then browse senders' 'Don''t remove, but show me those senders' 'Forget it -- do nothing -- sorry I asked' ) values: #( #doRemove #removeAndBrowse #browseSenders nil ). choice isNil ifFalse: [ ^ self perform: choice ]! ! !OBCmdRemoveMethod methodsFor: 'accessing' stamp: 'lr 6/9/2007 09:59'! icon ^ #deleteIcon! ! !OBCmdRemoveMethod methodsFor: 'testing' stamp: 'dr 9/30/2008 11:27'! isActive ^ (target isKindOf: OBMethodNode) and: [requestor isSelected: target]! ! !OBCmdRemoveMethod methodsFor: 'accessing' stamp: 'cwp 12/8/2006 23:18'! keystroke ^ $x! ! !OBCmdRemoveMethod methodsFor: 'accessing' stamp: 'lr 8/8/2010 10:07'! label ^ 'Remove method...'! ! !OBCmdRemoveMethod methodsFor: 'private' stamp: 'cwp 12/9/2006 20:37'! removeAndBrowse self browseSenders. self doRemove! ! OBCommand subclass: #OBCmdRenameClass instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'OB-Standard-Commands'! !OBCmdRenameClass methodsFor: 'execution' stamp: 'cwp 11/2/2006 23:47'! browseObsoleteRefs: aClassNode as: oldName | binding | binding := aClassNode theNonMetaClass environment associationAt: aClassNode theNonMetaClass name. (SystemNavigation default allCallsOn: binding) isEmpty ifFalse: [OBReferencesBrowser browseRoot: aClassNode title: 'Obsolete references to']! ! !OBCmdRenameClass methodsFor: 'private' stamp: 'lr 11/25/2010 23:41'! doRename: oldName to: newName target theNonMetaClass environment renameClassNamed: oldName as: newName. target announceChangedWith: requestor announcer! ! !OBCmdRenameClass methodsFor: 'execution' stamp: 'lr 7/26/2011 08:55'! execute | newName oldName | newName := OBTextRequest prompt: 'Please type new class name' template: target theNonMetaClassName asString. newName isNil ifTrue: [ ^ self ]. oldName := target theNonMetaClass name. self doRename: oldName to: newName asSymbol. self browseObsoleteRefs: target copy as: oldName! ! !OBCmdRenameClass methodsFor: 'accessing' stamp: 'cwp 11/2/2006 23:58'! group ^ #identity! ! !OBCmdRenameClass methodsFor: 'testing' stamp: 'cwp 11/2/2006 23:01'! isActive ^ (target isKindOf: OBClassNode) and: [requestor isSelected: target]! ! !OBCmdRenameClass methodsFor: 'accessing' stamp: 'lr 8/8/2010 10:07'! label ^ 'Rename...'! ! OBCommand subclass: #OBCmdResetSearch instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'OB-Standard-Commands'! !OBCmdResetSearch methodsFor: 'execution' stamp: 'cwp 11/10/2011 22:48'! execute target setCollection: OrderedCollection new. requestor refresh.! ! !OBCmdResetSearch methodsFor: 'testing' stamp: 'cwp 7/20/2007 22:11'! isActive ^ target isKindOf: OBCollectionNode! ! !OBCmdResetSearch methodsFor: 'accessing' stamp: 'lr 8/8/2010 10:07'! label ^ 'Reset list'! ! OBCommand subclass: #OBCmdRevertMethod instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'OB-Standard-Commands'! !OBCmdRevertMethod methodsFor: 'accessing' stamp: 'lr 8/8/2010 10:14'! buttonLabel ^ 'Revert'! ! !OBCmdRevertMethod methodsFor: 'execution' stamp: 'lr 3/12/2010 10:32'! execute target version fileIn: target theClass! ! !OBCmdRevertMethod methodsFor: 'testing' stamp: 'cwp 10/9/2006 18:30'! isActive ^ (target isKindOf: OBMethodVersionNode) and: [requestor isSelected: target]! ! !OBCmdRevertMethod methodsFor: 'accessing' stamp: 'cwp 10/9/2006 18:26'! keystroke ^ $r! ! !OBCmdRevertMethod methodsFor: 'accessing' stamp: 'lr 8/8/2010 10:07'! label ^ 'Revert to version'! ! !OBCmdRevertMethod methodsFor: 'accessing' stamp: 'lr 11/17/2011 00:13'! longDescription ^ 'Reverts the method to the current selection.'! ! OBCommand subclass: #OBCmdSelectMethodCategory instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'OB-Standard-Commands'! !OBCmdSelectMethodCategory methodsFor: 'execution' stamp: 'cb 4/15/2008 22:24'! execute (requestor parent isKindOf: OBAllMethodCategoryNode) ifTrue: [self select: (OBMethodCategoryNode on: (target theClass organization categoryOfElement: target selector) inClass: target theClass) with: requestor announcer ] ifFalse: [self select: (OBAllMethodCategoryNode on: target theClass) with: requestor announcer ]. self select: target with: requestor announcer! ! !OBCmdSelectMethodCategory methodsFor: 'testing' stamp: 'dc. 12/15/2007 15:18'! isActive ^ (target isKindOf: OBMethodNode) and: [requestor isSelected: target]! ! !OBCmdSelectMethodCategory methodsFor: 'accessing' stamp: 'dc. 12/15/2007 15:36'! keystroke ^ $C! ! !OBCmdSelectMethodCategory methodsFor: 'accessing' stamp: 'lr 8/8/2010 10:07'! label ^ 'Toggle all/category'! ! OBSystemBrowserAdaptor initialize! OBCmdAutoCategorize initialize! OBCodeBrowser initialize!