# HG changeset patch # User Claus Gittinger # Date 1309526171 -7200 # Node ID 1830dd78081386e3a9f4faff96d317af2044fc31 # Parent fb124983446384b2eef77b55b7a57d41e3660a3c initial checkin diff -r fb1249834463 -r 1830dd780813 Bookmark.st --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/Bookmark.st Fri Jul 01 15:16:11 2011 +0200 @@ -0,0 +1,863 @@ +" + COPYRIGHT (c) 2006 by eXept Software AG + All Rights Reserved + + This software is furnished under a license and may be used + only in accordance with the terms of that license and with the + inclusion of the above copyright notice. This software may not + be provided or otherwise made available to, or used by, any + other person. No title to or ownership of the software is + hereby transferred. +" +"{ Package: 'stx:libtool' }" + +HierarchicalItem subclass:#Bookmark + instanceVariableNames:'label icon' + classVariableNames:'' + poolDictionaries:'' + category:'Interface-Bookmarks' +! + +Bookmark subclass:#Class + instanceVariableNames:'className' + classVariableNames:'' + poolDictionaries:'' + privateIn:Bookmark +! + +Bookmark subclass:#File + instanceVariableNames:'path' + classVariableNames:'' + poolDictionaries:'' + privateIn:Bookmark +! + +Bookmark subclass:#Folder + instanceVariableNames:'name' + classVariableNames:'' + poolDictionaries:'' + privateIn:Bookmark +! + +Bookmark subclass:#Method + instanceVariableNames:'className selector' + classVariableNames:'' + poolDictionaries:'' + privateIn:Bookmark +! + +Bookmark::Folder subclass:#Recent + instanceVariableNames:'limit' + classVariableNames:'' + poolDictionaries:'' + privateIn:Bookmark +! + +Bookmark subclass:#Separator + instanceVariableNames:'' + classVariableNames:'' + poolDictionaries:'' + privateIn:Bookmark +! + +Bookmark subclass:#URL + instanceVariableNames:'url' + classVariableNames:'' + poolDictionaries:'' + privateIn:Bookmark +! + +!Bookmark class methodsFor:'documentation'! + +copyright +" + COPYRIGHT (c) 2006 by eXept Software AG + All Rights Reserved + + This software is furnished under a license and may be used + only in accordance with the terms of that license and with the + inclusion of the above copyright notice. This software may not + be provided or otherwise made available to, or used by, any + other person. No title to or ownership of the software is + hereby transferred. +" +! ! + +!Bookmark class methodsFor:'instance creation'! + +forClass: aClass + + ^Bookmark::Class new className: aClass name + + " + Bookmark forClass: Collection + " + + "Created: / 05-05-2011 / 23:05:30 / Jan Vrany " + "Modified: / 23-05-2011 / 13:51:39 / Jan Vrany " +! + +forClass: class selector: selector + + ^Bookmark::Method new className: class name selector: selector + + " + Bookmark forMethod: Bookmark class >> #forMethod: + " + + "Created: / 02-06-2011 / 23:21:38 / Jan Vrany " +! + +forFile: aStringOrFilename + + ^Bookmark::File new path: aStringOrFilename asString + + " + Bookmark forFile: '/etc/passwd' + " + + "Created: / 20-06-2011 / 22:07:44 / Jan Vrany " +! + +forFolderNamed: aString + + ^Bookmark::Folder new name: aString + + " + Bookmark forClass: Collection + " + + "Created: / 23-05-2011 / 10:02:30 / Jan Vrany " +! + +forMethod: aMethod + + ^Bookmark::Method new className: aMethod mclass name selector: aMethod selector + + " + Bookmark forMethod: Bookmark class >> #forMethod: + " + + "Created: / 05-05-2011 / 23:05:41 / Jan Vrany " + "Modified: / 23-05-2011 / 13:49:46 / Jan Vrany " +! + +forRecent + + ^Bookmark::Recent new + + " + Bookmark forRecent + " + + "Created: / 03-06-2011 / 10:50:21 / Jan Vrany " +! + +forUrl: url label: label + + ^Bookmark::URL new url: url; label: label + + " + Bookmark forClass: Collection + " + + "Created: / 08-06-2011 / 12:44:26 / Jan Vrany " +! + +separator + + ^Bookmark::Separator new + + " + Bookmark forRecent + " + + "Created: / 03-06-2011 / 13:39:44 / Jan Vrany " +! ! + +!Bookmark methodsFor:'accessing'! + +/ label + + self do:[:e|e label = label ifTrue:[^e]]. + self error:'No child with label ''' , label , ''''. + + "Created: / 21-06-2011 / 08:49:37 / Jan Vrany " +! + +icon + "superclass BookmarkEntry says that I am responsible to implement this method" + + icon ifNil:[ self initializeIcon ]. + ^ icon + + "Created: / 05-05-2011 / 22:52:11 / Jan Vrany " +! + +label + "superclass BookmarkEntry says that I am responsible to implement this method" + + label ifNil:[ self initializeLabel ]. + ^label + ifNil:[ self defaultLabel ] + ifNotNil: [ label ]. + + "Created: / 05-05-2011 / 22:56:35 / Jan Vrany " + "Modified: / 02-06-2011 / 11:56:24 / Jan Vrany " +! + +label: aStringOrText + + label := aStringOrText. + self model changed: #label with: self + + "Created: / 02-06-2011 / 23:13:52 / Jan Vrany " + "Modified: / 03-06-2011 / 10:46:28 / Jan Vrany " +! ! + +!Bookmark methodsFor:'accessing defaults'! + +defaultLabel + self subclassResponsibility + + "Created: / 02-06-2011 / 11:56:24 / Jan Vrany " +! ! + +!Bookmark methodsFor:'basic adding & removing'! + +basicAddAll:aList beforeIndex:anIndex + + aList do:[:each|each parent: self]. + ^super basicAddAll:aList beforeIndex:anIndex + + "Created: / 23-05-2011 / 14:10:44 / Jan Vrany " +! + +basicRemoveFromIndex:startIndex toIndex:stopIndex + "remove the children from startIndex up to and including + the child under stopIndex." + + |model notify + index "{ Class:SmallInteger }" + start "{ Class:SmallInteger }" + stop "{ Class:SmallInteger }" + size "{ Class:SmallInteger }"| + + size := self children size. + stop := stopIndex. + start := startIndex. + (stop <= size and:[ start between:1 and:stop ]) + ifFalse:[ ^ self subscriptBoundsError:index ]. + start == 1 + ifTrue:[ notify := self ] + ifFalse: + [ stop == size + ifTrue:[ notify := self at:(start - 1) ] + ifFalse:[ notify := nil ] ]. + (model := self model) notNil + ifTrue: + [ index := model identityIndexOf:(children at:start). + size := stop - start + 1. ] + ifFalse:[ index := 0 ]. + children + from:start + to:stop + do: + [:aChild | + index ~~ 0 ifTrue:[ size := size + aChild numberOfVisibleChildren ]. + aChild parent:nil ]. + children removeFromIndex:start toIndex:stop. + index ~~ 0 + ifTrue:[ model itemRemoveFromIndex:index toIndex:(index + size - 1) ]. + notify notNil ifTrue:[ notify changed ]. + + "Created: / 23-05-2011 / 16:21:11 / Jan Vrany " +! ! + +!Bookmark methodsFor:'change & update'! + +changed: aspect with: param + + | model | + + super changed: aspect with: param. + (model := self model) notNil ifTrue: + [model changed: aspect with: param]. + + "Created: / 23-05-2011 / 16:22:23 / Jan Vrany " +! ! + +!Bookmark methodsFor:'converting'! + +asMenu + + ^self asMenuUsingBuilder: BookmarkToolbarMenuBuilder + + "Created: / 23-05-2011 / 10:32:41 / Jan Vrany " + "Modified: / 21-06-2011 / 08:05:24 / Jan Vrany " +! + +asMenuUsingBuilder: builderClass + + ^builderClass buildMenuFor: self + + "Created: / 21-06-2011 / 08:04:22 / Jan Vrany " +! ! + +!Bookmark methodsFor:'encoding & decoding'! + +skippedInLiteralEncoding + + ^#(parent isExpanded height width icon) + + "Created: / 05-05-2011 / 23:08:03 / Jan Vrany " + "Modified: / 02-06-2011 / 22:56:25 / Jan Vrany " +! ! + +!Bookmark methodsFor:'navigation'! + +switchToBookmarkIn: application + + application switchToBookmarkEntry: application + + "Created: / 05-05-2011 / 23:47:30 / Jan Vrany " +! ! + +!Bookmark methodsFor:'printing & storing'! + +printOn:aStream + "append a printed representation if the receiver to the argument, aStream" + + aStream nextPutAll:'BKM['. + self label printOn: aStream. + aStream nextPut: $] + + "Modified: / 02-06-2011 / 11:08:41 / Jan Vrany " +! ! + +!Bookmark methodsFor:'private'! + +initializeIcon + "Created: / 05-05-2011 / 22:57:56 / Jan Vrany " +! + +initializeLabel + + label := '--------' + + "Created: / 05-05-2011 / 22:56:35 / Jan Vrany " + "Modified: / 03-06-2011 / 13:45:05 / Jan Vrany " +! ! + +!Bookmark methodsFor:'testing'! + +isClassBookmark + + ^false + + "Created: / 05-05-2011 / 23:44:17 / Jan Vrany " +! + +isFileBookmark + + ^false + + "Created: / 20-06-2011 / 23:40:24 / Jan Vrany " +! + +isFolderBookmark + + ^false + + "Created: / 23-05-2011 / 09:59:31 / Jan Vrany " +! + +isMethodBookmark + + ^false + + "Created: / 05-05-2011 / 23:44:21 / Jan Vrany " +! + +isRecentBookmark + + ^false + + "Created: / 03-06-2011 / 10:50:39 / Jan Vrany " +! + +isURLBookmark + + ^false + + "Created: / 20-06-2011 / 23:40:29 / Jan Vrany " +! ! + +!Bookmark::Class methodsFor:'accessing'! + +className + + ^className + + "Created: / 05-05-2011 / 23:55:30 / Jan Vrany " + "Modified: / 23-05-2011 / 13:36:09 / Jan Vrany " +! + +className:aString + className := aString. + +! ! + +!Bookmark::Class methodsFor:'accessing defaults'! + +defaultLabel + "superclass Bookmark says that I am responsible to implement this method" + + ^ 'Some Class...' + + "Modified: / 02-06-2011 / 11:59:06 / Jan Vrany " +! ! + +!Bookmark::Class methodsFor:'comparing'! + += another + + ^(self class = another class) + and:[className = another className] + + "Created: / 05-05-2011 / 23:33:40 / Jan Vrany " + "Modified: / 23-05-2011 / 13:59:16 / Jan Vrany " +! + +hash + + ^className hash bitXor: self class hash + + "Created: / 05-05-2011 / 23:32:01 / Jan Vrany " + "Modified: / 23-05-2011 / 13:59:25 / Jan Vrany " +! ! + +!Bookmark::Class methodsFor:'navigation'! + +switchToBookmarkIn: application + + application switchToClass: (Smalltalk at: className) selector: nil updateHistory: false + + "Created: / 05-05-2011 / 23:49:16 / Jan Vrany " + "Modified: / 23-05-2011 / 13:36:31 / Jan Vrany " +! ! + +!Bookmark::Class methodsFor:'private'! + +initializeIcon + + | cls | + cls := Smalltalk at: className. + cls ifNotNil:[icon := SystemBrowser iconForClass: cls]. + + "Created: / 05-05-2011 / 23:01:40 / Jan Vrany " + "Modified: / 23-05-2011 / 22:17:33 / Jan Vrany " +! + +initializeLabel + + className ifNil:[^self]. + + label := className copyFrom: (className lastIndexOf: $:) + 1 + + "Created: / 05-05-2011 / 23:03:23 / Jan Vrany " + "Modified: / 02-06-2011 / 11:57:05 / Jan Vrany " +! ! + +!Bookmark::Class methodsFor:'testing'! + +isClassBookmark + + ^true + + "Created: / 05-05-2011 / 23:44:56 / Jan Vrany " +! ! + +!Bookmark::Class methodsFor:'visiting'! + +acceptVisitor:aVisitor + "Double dispatch back to the visitor, passing my type encoded in + the selector (visitor pattern)" + + "stub code automatically generated - please change if required" + + ^ aVisitor visitClass:self +! ! + +!Bookmark::File methodsFor:'accessing'! + +initializeLabel + + label := path asFilename baseName + + "Created: / 20-06-2011 / 22:09:10 / Jan Vrany " +! + +path + ^ path +! + +path:something + path := something. +! ! + +!Bookmark::File methodsFor:'accessing defaults'! + +defaultLabel + "superclass Bookmark says that I am responsible to implement this method" + + ^ 'Some file...' + + "Modified: / 20-06-2011 / 22:08:46 / Jan Vrany " +! ! + +!Bookmark::File methodsFor:'testing'! + +isFileBookmark + + ^true + + "Created: / 20-06-2011 / 23:40:47 / Jan Vrany " +! ! + +!Bookmark::File methodsFor:'visiting'! + +acceptVisitor:aVisitor + "Double dispatch back to the visitor, passing my type encoded in + the selector (visitor pattern)" + + "stub code automatically generated - please change if required" + + ^ aVisitor visitFile:self +! ! + +!Bookmark::Folder methodsFor:'accessing'! + +initializeIcon + + + ^ icon := ToolbarIconLibrary directoryOpen22x24Icon1 + + "Created: / 02-06-2011 / 12:10:30 / Jan Vrany " +! + +initializeLabel + "superclass Bookmark says that I am responsible to implement this method" + + ^ label := self name + + "Created: / 23-05-2011 / 14:08:26 / Jan Vrany " + "Modified: / 02-06-2011 / 11:52:09 / Jan Vrany " +! + +label + + ^self name + + "Created: / 02-06-2011 / 11:51:49 / Jan Vrany " +! + +label: aString + + self name: aString + + "Created: / 03-06-2011 / 10:45:37 / Jan Vrany " +! + +name + + ^name ? 'New Folder...' + + "Created: / 23-05-2011 / 10:02:21 / Jan Vrany " + "Modified: / 02-06-2011 / 11:52:03 / Jan Vrany " +! + +name: aString + + name := aString. + self model changed: #label with: self + + "Created: / 23-05-2011 / 10:02:11 / Jan Vrany " + "Modified: / 03-06-2011 / 10:46:39 / Jan Vrany " +! ! + +!Bookmark::Folder methodsFor:'accessing defaults'! + +defaultLabel + "superclass Bookmark says that I am responsible to implement this method" + + ^ 'New Folder...' + + "Modified: / 02-06-2011 / 11:58:57 / Jan Vrany " +! ! + +!Bookmark::Folder methodsFor:'testing'! + +isFolderBookmark + + ^true + + "Created: / 23-05-2011 / 10:00:02 / Jan Vrany " +! ! + +!Bookmark::Folder methodsFor:'utilities'! + +moveDown: child + + | index | + index := children identityIndexOf: child. + index = children size ifTrue:[^self]. + self removeIndex: index. + self add: child afterIndex: index. + + "Created: / 02-06-2011 / 11:04:43 / Jan Vrany " +! + +moveIn: child + + | index folder | + index := children identityIndexOf: child. + index = children size ifTrue:[^self]. + folder := children at: index + 1. + folder isFolderBookmark ifFalse:[^self]. + self removeIndex: index. + folder addFirst: child + + "Created: / 03-06-2011 / 10:30:18 / Jan Vrany " +! + +moveOut: child + + | index myindex | + self parent ifNil:[^self]. + index := children identityIndexOf: child. + myindex := self parent children identityIndexOf: self. + self removeIndex: index. + self parent add: child afterIndex: myindex. + + "Created: / 03-06-2011 / 10:32:28 / Jan Vrany " +! + +moveUp: child + + | index | + index := children identityIndexOf: child. + index = 1 ifTrue:[^self]. + self removeIndex: index. + self add: child beforeIndex: index - 1. + + "Created: / 02-06-2011 / 11:04:04 / Jan Vrany " +! ! + +!Bookmark::Folder methodsFor:'visiting'! + +acceptVisitor:aVisitor + "Double dispatch back to the visitor, passing my type encoded in + the selector (visitor pattern)" + + "stub code automatically generated - please change if required" + + ^ aVisitor visitFolder:self +! ! + +!Bookmark::Method methodsFor:'accessing'! + +className + + ^className + + "Created: / 05-05-2011 / 23:55:30 / Jan Vrany " + "Modified: / 23-05-2011 / 13:36:09 / Jan Vrany " +! + +className:aString + className := aString. +! + +className:classNameArg selector:selectorArg + className := classNameArg. + selector := selectorArg. +! + +selector + ^ selector + +! + +selector: aSymbol + selector := aSymbol + +! ! + +!Bookmark::Method methodsFor:'accessing defaults'! + +defaultLabel + "superclass Bookmark says that I am responsible to implement this method" + + ^ 'Some Method...' + + "Modified: / 02-06-2011 / 11:58:48 / Jan Vrany " +! ! + +!Bookmark::Method methodsFor:'navigation'! + +switchToBookmarkIn: application + + application + switchToClass: (Smalltalk at: className) + selector: selector + updateHistory: false + + "Created: / 05-05-2011 / 23:49:55 / Jan Vrany " + "Modified: / 23-05-2011 / 13:38:02 / Jan Vrany " +! ! + +!Bookmark::Method methodsFor:'private'! + +initializeLabel + + className ifNil:[^self]. + selector ifNil:[^self]. + + label := + (className copyFrom: ((className lastIndexOf: $:) + 1)) asText allBold , + ' >> ' , (selector asText "allItalic") + + "Created: / 05-05-2011 / 23:04:20 / Jan Vrany " + "Modified: / 02-06-2011 / 22:00:08 / Jan Vrany " +! ! + +!Bookmark::Method methodsFor:'testing'! + +isMethodBookmark + + ^true + + "Created: / 05-05-2011 / 23:44:51 / Jan Vrany " +! ! + +!Bookmark::Method methodsFor:'visiting'! + +acceptVisitor:aVisitor + "Double dispatch back to the visitor, passing my type encoded in + the selector (visitor pattern)" + + "stub code automatically generated - please change if required" + + ^ aVisitor visitMethod:self +! ! + +!Bookmark::Recent methodsFor:'accessing'! + +limit + ^ limit ? 15 + + "Modified: / 03-06-2011 / 10:51:40 / Jan Vrany " +! + +limit:something + limit := something. +! ! + +!Bookmark::Recent methodsFor:'testing'! + +isFolderBookmark + + ^false + + "Created: / 03-06-2011 / 10:51:14 / Jan Vrany " +! + +isRecentBookmark + + ^true + + "Created: / 03-06-2011 / 10:51:06 / Jan Vrany " +! ! + +!Bookmark::Recent methodsFor:'visiting'! + +acceptVisitor:aVisitor + "Double dispatch back to the visitor, passing my type encoded in + the selector (visitor pattern)" + + "stub code automatically generated - please change if required" + + ^ aVisitor visitRecent:self +! ! + +!Bookmark::Separator methodsFor:'visiting'! + +acceptVisitor:aVisitor + "Double dispatch back to the visitor, passing my type encoded in + the selector (visitor pattern)" + + "stub code automatically generated - please change if required" + + ^ aVisitor visitSeparator:self +! ! + +!Bookmark::URL methodsFor:'accessing'! + +url + ^ url +! + +url:aString + url := aString. +! ! + +!Bookmark::URL methodsFor:'comparing'! + += another + + ^(self class = another class) + and:[label = another label + and:[url = another url]]. + + "Created: / 08-06-2011 / 15:11:04 / Jan Vrany " +! + +hash + + ^label asString hash bitXor:[url hash]. + + "Created: / 08-06-2011 / 15:10:59 / Jan Vrany " +! ! + +!Bookmark::URL methodsFor:'testing'! + +isURLBookmark + + ^true + + "Created: / 20-06-2011 / 23:40:39 / Jan Vrany " +! ! + +!Bookmark::URL methodsFor:'visiting'! + +acceptVisitor:aVisitor + "Double dispatch back to the visitor, passing my type encoded in + the selector (visitor pattern)" + + "stub code automatically generated - please change if required" + + ^ aVisitor visitURL:self + + "Modified: / 16-06-2011 / 16:07:59 / Jan Vrany " +! ! + +!Bookmark class methodsFor:'documentation'! + +version_CVS + ^ '$Header: /cvs/stx/stx/libtool/Bookmark.st,v 1.1 2011-07-01 13:16:11 cg Exp $' +! + +version_SVN + ^ '§Id§' +! !