'From Squeak3.5 of ''11 April 2003'' [latest update: #5180] on 19 June 2003 at 10:09:52 am'! "Change Set: FileListDnD-nk Date: 19 June 2003 Author: Ned Konz rev. 4: made drops into current directory work right. rev. 3: added keyboard handling. The TransferMorph now polls the shift state in its step method to update its copy state (shift pressed = should copy). And if you hit the Escape key while dragging, it aborts the drag operation. rev. 2: made drop on file list be ignored. Adds drag'n'drop to the FileList2 and FileList. You can drag from the file list (the upper right list) to the directory/volume list (the upper left list) to move or copy files. Hold down the SHIFT key before you start dragging if you want to copy. You can also drag between two different FileLists. Use with a single list is probably more useful with FileList2 because you can see more directories at once. (note: this CS also incorporates FileList2Pref-nk, which had the following comments:) This also adds a Preference (general/useFileList2) that lets you use the enhanced file browser from the World menu. It also allows entry of multiple patterns into a file list browser. You can separate patterns by newlines (like in a FileList2), or by a semicolon ($;), like in a FileList. So for instance you could view any .changes or .image files at once. " Preferences addPreference: #useFileList2 categories: #(general) default: true balloonHelp: 'if true, then when you open a file list from the World menu, it''ll be an enhanced one'! !TransferMorph commentStamp: 'nk 6/16/2003 16:52' prior: 0! This is a Morph that is used to visually indicate the progress of a drag operation, and also as a container for various bits of drag state information. It polls the shift state in its step method to update its copy state (shift pressed = should copy). And if you hit the Escape key while dragging, it aborts the drag operation.! !FileList methodsFor: 'drag''n''drop' stamp: 'nk 6/19/2003 10:08'! acceptDroppingMorph: aTransferMorph event: evt inMorph: dest | oldName oldEntry destDirectory newName newEntry baseName response | destDirectory _ self dropDestinationDirectory: dest event: evt. oldName _ aTransferMorph passenger. baseName _ FileDirectory localNameFor: oldName. newName _ destDirectory fullNameFor: baseName. newName = oldName ifTrue: [ "Transcript nextPutAll: 'same as old name'; cr." ^ true ]. oldEntry _ FileDirectory directoryEntryFor: oldName. newEntry _ FileDirectory directoryEntryFor: newName. newEntry ifNotNil: [ | msg | msg _ String streamContents: [ :s | s nextPutAll: 'destination file '; nextPutAll: newName; nextPutAll: ' exists already,'; cr; nextPutAll: 'and is '; nextPutAll: (oldEntry modificationTime < newEntry modificationTime ifTrue: [ 'newer' ] ifFalse: [ 'not newer' ]); nextPutAll: ' than source file '; nextPutAll: oldName; nextPut: $.; cr; nextPutAll: 'Overwrite file '; nextPutAll: newName; nextPut: $? ]. response _ self confirm: msg. response ifFalse: [ ^false ]. ]. aTransferMorph shouldCopy ifTrue: [ self primitiveCopyFileNamed: oldName to: newName ] ifFalse: [ directory rename: oldName toBe: newName ]. self updateFileList; fileListIndex: 0. aTransferMorph source model ~= self ifTrue: [ aTransferMorph source model updateFileList; fileListIndex: 0 ]. "Transcript nextPutAll: 'copied'; cr." ^true! ! !FileList methodsFor: 'drag''n''drop' stamp: 'nk 6/14/2003 12:58'! dragPassengerFor: item inMorph: dragSource ^self directory fullNameFor: ((self fileNameFromFormattedItem: item contents copy) copyReplaceAll: self folderString with: ''). ! ! !FileList methodsFor: 'drag''n''drop' stamp: 'nk 6/14/2003 11:16'! dragTransferTypeForMorph: aMorph ^#file! ! !FileList methodsFor: 'drag''n''drop' stamp: 'nk 6/15/2003 13:07'! dropDestinationDirectory: dest event: evt "Answer a FileDirectory representing the drop destination in the volume list morph dest" | index dir delim path | index _ volList indexOf: (dest itemFromPoint: evt position) contents. index = 1 ifTrue: [dir _ FileDirectory on: ''] ifFalse: [delim _ directory pathNameDelimiter. path _ String streamContents: [:str | 2 to: index do: [:d | str nextPutAll: (volList at: d) withBlanksTrimmed. d < index ifTrue: [str nextPut: delim]]. nil]. dir _ directory on: path]. ^ dir! ! !FileList methodsFor: 'drag''n''drop' stamp: 'nk 6/15/2003 21:58'! isDirectoryList: aMorph ^aMorph getListSelector == #volumeList! ! !FileList methodsFor: 'drag''n''drop' stamp: 'nk 6/15/2003 13:10'! primitiveCopyFileNamed: srcName to: dstName "Copied from VMMaker code. This really ought to be a facility in file system. The major annoyance here is that file types and permissions are not handled by current Squeak code. NOTE that this will clobber the destination file!!" | buffer src dst | "primitiveExternalCall" "If the plugin doesn't do it, go the slow way and lose the filetype info" "This method may signal FileDoesNotExistException if either the source or dest files cannnot be opened; possibly permissions or bad name problems" [[src _ FileStream readOnlyFileNamed: srcName] on: FileDoesNotExistException do: [^ self couldNotOpenFile: srcName]. [dst _ FileStream forceNewFileNamed: dstName] on: FileDoesNotExistException do: [^ self couldNotOpenFile: dstName]. buffer _ String new: 50000. [src atEnd] whileFalse: [dst nextPutAll: (src nextInto: buffer)]] ensure: [src ifNotNil: [src close]. dst ifNotNil: [dst close]]! ! !FileList methodsFor: 'drag''n''drop' stamp: 'nk 6/19/2003 10:08'! wantsDroppedMorph: aTransferMorph event: evt inMorph: dest | retval | retval _ (aTransferMorph isKindOf: TransferMorph) and: [ aTransferMorph dragTransferType == #file ] and: [ self isDirectoryList: dest ]. "retval ifFalse: [ Transcript nextPutAll: 'drop not wanted'; cr ]." ^retval! ! !FileList methodsFor: 'private' stamp: 'nk 2/20/2001 12:36'! listForPatterns: anArray "Make the list be those file names which match the pattern." | sizePad newList | newList _ Set new. anArray do: [ :pat | newList addAll: (self entriesMatching: pat) ]. newList _ (SortedCollection sortBlock: self sortBlock) addAll: newList; yourself. sizePad _ (newList inject: 0 into: [:mx :entry | mx max: (entry at: 5)]) asStringWithCommas size - 1. newList _ newList collect: [ :e | self fileNameFormattedFrom: e sizePad: sizePad ]. volList size = 1 ifTrue: ["Include known servers along with other desktop volumes" ^ newList asArray , (ServerDirectory serverNames collect: [:n | '^' , n , self folderString])]. ^ newList asArray! ! !FileList methodsFor: 'private' stamp: 'nk 12/10/2002 07:57'! updateFileList "Update my files list with file names in the current directory that match the pattern. The pattern string may have embedded newlines or semicolons; these separate different patterns." | patterns | patterns _ OrderedCollection new. Cursor wait showWhile: [ (pattern findTokens: (String with: Character cr with: Character lf with: $;)) do: [ :each | (each includes: $*) | (each includes: $#) ifTrue: [ patterns add: each] ifFalse: [each isEmpty ifTrue: [ patterns add: '*'] ifFalse: [ patterns add: '*' , each , '*']]]. list _ self listForPatterns: patterns. listIndex _ 0. volListIndex _ volList size. fileName _ nil. contents _ ''. self changed: #volumeListIndex. self changed: #fileList. self updateButtonRow]! ! !FileList class methodsFor: 'instance creation' stamp: 'nk 6/15/2003 13:04'! addButtonsAndFileListPanesTo: window at: upperFraction plus: offset forFileList: aFileList | fileListMorph row buttonHeight fileListTop divider dividerDelta buttons | fileListMorph _ PluggableListMorph on: aFileList list: #fileList selected: #fileListIndex changeSelected: #fileListIndex: menu: #fileListMenu:. fileListMorph enableDrag: true; enableDrop: false. aFileList wantsOptionalButtons ifTrue: [buttons _ aFileList optionalButtonRow. divider _ BorderedSubpaneDividerMorph forBottomEdge. dividerDelta _ 0. Preferences alternativeWindowLook ifTrue: [buttons color: Color transparent. buttons submorphsDo: [:m | m borderWidth: 2; borderColor: #raised]. divider extent: 4 @ 4; color: Color transparent; borderColor: #raised; borderWidth: 2. fileListMorph borderColor: Color transparent. dividerDelta _ 3]. row _ AlignmentMorph newColumn hResizing: #spaceFill; vResizing: #spaceFill; layoutInset: 0; borderWidth: 2; layoutPolicy: ProportionalLayout new. buttonHeight _ self defaultButtonPaneHeight. row addMorph: buttons fullFrame: (LayoutFrame fractions: (0 @ 0 corner: 1 @ 0) offsets: (0 @ 0 corner: 0 @ buttonHeight)). row addMorph: divider fullFrame: (LayoutFrame fractions: (0 @ 0 corner: 1 @ 0) offsets: (0 @ buttonHeight corner: 0 @ buttonHeight + dividerDelta)). row addMorph: fileListMorph fullFrame: (LayoutFrame fractions: (0 @ 0 corner: 1 @ 1) offsets: (0 @ buttonHeight + dividerDelta corner: 0 @ 0)). window addMorph: row fullFrame: (LayoutFrame fractions: upperFraction offsets: (0 @ offset corner: 0 @ 0)). Preferences alternativeWindowLook ifTrue: [row borderWidth: 2] ifFalse: [row borderWidth: 0]] ifFalse: [fileListTop _ 0. window addMorph: fileListMorph frame: (0.3 @ fileListTop corner: 1 @ 0.3)].! ! !FileList class methodsFor: 'instance creation' stamp: 'nk 6/15/2003 13:04'! addVolumesAndPatternPanesTo: window at: upperFraction plus: offset forFileList: aFileList | row patternHeight volumeListMorph patternMorph divider dividerDelta | row _ AlignmentMorph newColumn hResizing: #spaceFill; vResizing: #spaceFill; layoutInset: 0; borderWidth: 0; layoutPolicy: ProportionalLayout new. patternHeight _ 25. volumeListMorph _ (PluggableListMorph on: aFileList list: #volumeList selected: #volumeListIndex changeSelected: #volumeListIndex: menu: #volumeMenu:) autoDeselect: false. volumeListMorph enableDrag: false; enableDrop: true. patternMorph _ PluggableTextMorph on: aFileList text: #pattern accept: #pattern:. patternMorph acceptOnCR: true. patternMorph hideScrollBarIndefinitely. divider _ BorderedSubpaneDividerMorph horizontal. dividerDelta _ 0. Preferences alternativeWindowLook ifTrue: [divider extent: 4 @ 4; color: Color transparent; borderColor: #raised; borderWidth: 2. volumeListMorph borderColor: Color transparent. patternMorph borderColor: Color transparent. dividerDelta _ 3]. row addMorph: (volumeListMorph autoDeselect: false) fullFrame: (LayoutFrame fractions: (0 @ 0 corner: 1 @ 1) offsets: (0 @ 0 corner: 0 @ patternHeight negated - dividerDelta)). row addMorph: divider fullFrame: (LayoutFrame fractions: (0 @ 1 corner: 1 @ 1) offsets: (0 @ patternHeight negated - dividerDelta corner: 0 @ patternHeight negated)). row addMorph: patternMorph fullFrame: (LayoutFrame fractions: (0 @ 1 corner: 1 @ 1) offsets: (0 @ patternHeight negated corner: 0 @ 0)). window addMorph: row fullFrame: (LayoutFrame fractions: upperFraction offsets: (0 @ offset corner: 0 @ 0)). Preferences alternativeWindowLook ifTrue: [row borderWidth: 2] ifFalse: [row borderWidth: 0]! ! !FileList2 methodsFor: 'as yet unclassified' stamp: 'nk 6/15/2003 13:06'! morphicDirectoryTreePaneFiltered: aSymbol ^(SimpleHierarchicalListMorph on: self list: aSymbol selected: #currentDirectorySelected changeSelected: #setSelectedDirectoryTo: menu: nil keystroke: nil) autoDeselect: false; enableDrag: false; enableDrop: true; yourself ! ! !FileList2 methodsFor: 'as yet unclassified' stamp: 'nk 6/15/2003 13:05'! morphicFileListPane ^(PluggableListMorph on: self list: #fileList selected: #fileListIndex changeSelected: #fileListIndex: menu: #fileListMenu:) enableDrag: true; enableDrop: false; yourself ! ! !FileList2 methodsFor: 'drag''n''drop' stamp: 'nk 6/15/2003 13:07'! dropDestinationDirectory: dest event: evt "Answer a FileDirectory representing the drop destination in the directory hierarchy morph dest" ^ (dest itemFromPoint: evt position) withoutListWrapper! ! !FileList2 methodsFor: 'drag''n''drop' stamp: 'nk 6/15/2003 22:00'! isDirectoryList: aMorph ^aMorph isKindOf: SimpleHierarchicalListMorph! ! !FileList2 methodsFor: 'volume list and pattern' stamp: 'nk 2/20/2001 12:09'! listForPatterns: anArray "Make the list be those file names which match the patterns." | sizePad newList | directory ifNil: [^#()]. (fileSelectionBlock isKindOf: MessageSend) ifTrue: [ fileSelectionBlock arguments: {directory entries}. newList _ fileSelectionBlock value. fileSelectionBlock arguments: #(). ] ifFalse: [ newList _ Set new. anArray do: [ :pat | newList addAll: (directory entries select: [:entry | fileSelectionBlock value: entry value: pat]) ]. ]. newList _ newList asSortedCollection: self sortBlock. sizePad _ (newList inject: 0 into: [:mx :entry | mx max: (entry at: 5)]) asStringWithCommas size - 1. newList _ newList collect: [ :e | self fileNameFormattedFrom: e sizePad: sizePad ]. ^ newList asArray! ! !SimpleHierarchicalListMorph methodsFor: 'dropping/grabbing' stamp: 'nk 6/15/2003 11:49'! acceptDroppingMorph: aMorph event: evt self model acceptDroppingMorph: aMorph event: evt inMorph: self. self resetPotentialDropMorph. evt hand releaseMouseFocus: self. Cursor normal show. ! ! !TheWorldMenu methodsFor: 'commands' stamp: 'nk 3/24/2003 14:30'! openFileList Preferences useFileList2 ifTrue: [ FileList2 morphicView openInWorld: myWorld ] ifFalse: [ FileList openAsMorph openInWorld: myWorld ]! ! !TransferMorph methodsFor: 'accessing' stamp: 'nk 6/16/2003 16:29'! shouldCopy: aBoolean copy := aBoolean.! ! !TransferMorph methodsFor: 'dropping/grabbing' stamp: 'nk 6/16/2003 16:51'! aboutToBeGrabbedBy: aHand "The receiver is being grabbed by a hand. Perform necessary adjustments (if any) and return the actual morph that should be added to the hand." "Since this morph has been initialized automatically with bounds origin 0@0, we have to move it to aHand position." super aboutToBeGrabbedBy: aHand. self draggedMorph. self align: self bottomLeft with: aHand position. aHand newKeyboardFocus: self.! ! !TransferMorph methodsFor: 'initialization' stamp: 'nk 6/16/2003 16:50'! initialize "initialize the state of the receiver" super initialize. self layoutPolicy: TableLayout new. self listDirection: #leftToRight; hResizing: #shrinkWrap; vResizing: #shrinkWrap; layoutInset: 3; wrapCentering: #center; cellPositioning: #leftCenter. accepted _ false. copy _ false. self on: #keyStroke send: #keyStroke: to: self! ! !TransferMorph methodsFor: 'stepping and presenter' stamp: 'nk 6/16/2003 16:41'! step self shouldCopy: Sensor shiftPressed. self updateCopyIcon! ! !TransferMorph methodsFor: 'stepping and presenter' stamp: 'nk 6/16/2003 16:42'! stepTime ^100! ! !TransferMorph methodsFor: 'private' stamp: 'nk 6/16/2003 16:49'! initDraggedMorph draggedMorph ifNotNil: [^self]. draggedMorph := self passenger asDraggableMorph. self addMorphBack: draggedMorph. self updateCopyIcon. self changed; fullBounds! ! !TransferMorph methodsFor: 'private' stamp: 'nk 6/16/2003 16:34'! updateCopyIcon | copyIcon | copyIcon _ self submorphWithProperty: #tmCopyIcon. (self shouldCopy and: [ copyIcon isNil ]) ifTrue: [ ^self addMorphFront: ((ImageMorph new image: CopyPlusIcon) setProperty: #tmCopyIcon toValue: true) ]. (self shouldCopy not and: [ copyIcon notNil ]) ifTrue: [ copyIcon delete ]! ! !TransferMorph methodsFor: 'event handling' stamp: 'nk 6/16/2003 16:51'! keyStroke: evt "Abort the drag on an escape" evt keyCharacter ~= Character escape ifTrue: [ ^self ]. self delete.! ! !TransferMorph class methodsFor: 'instance creation' stamp: 'nk 6/16/2003 16:29'! withPassenger: anObject from: source | ddm | ddm _ self new. ddm passenger: anObject. ddm source: source. Sensor shiftPressed ifTrue: [ddm shouldCopy: true]. ^ ddm! ! TransferMorph removeSelector: #copy! !TransferMorph reorganize! ('accessing' dragTransferType: draggedMorph draggedMorph: dropNotifyRecipient dropNotifyRecipient: move passenger passenger: shouldCopy shouldCopy: source source:) ('drag and drop' dragTransferType) ('dropping/grabbing' aboutToBeGrabbedBy: justDroppedInto:event: result: result:from: undoGrabCommand) ('initialization' initialize) ('stepping and presenter' step stepTime) ('submorphs-add/remove' delete) ('private' animationForMoveSuccess: initDraggedMorph privateFullMoveBy: updateCopyIcon) ('event handling' keyStroke:) ! !FileList2 reorganize! ('as yet unclassified' cancelHit currentDirectorySelected dirSelectionBlock: directoryChangeBlock: directoryNamesFor: fileSelectionBlock: getSelectedDirectory getSelectedFile importImage initialDirectoryList limitedSuperSwikiDirectoryList limitedSuperSwikiPublishDirectoryList modalView: morphicDirectoryTreePane morphicDirectoryTreePaneFiltered: morphicFileContentsPane morphicFileListPane morphicPatternPane okHit okHitForProjectLoader okayAndCancelServices openAsBackground openImageInWindow openProjectFromFile optionalButtonSpecs: postOpen publishingServers saveLocalOnlyHit serviceCancel serviceOkay serviceOpenProjectFromFile servicesForFolderSelector servicesForProjectLoader setSelectedDirectoryTo:) ('drag''n''drop' dropDestinationDirectory:event: isDirectoryList:) ('initialization' directory: labelString optionalButtonSpecs universalButtonServices) ('initialize-release' initialize) ('user interface' defaultBackgroundColor) ('volume list and pattern' directory listForPattern: listForPatterns:) ! !FileList reorganize! ('*pws') ('drag''n''drop' acceptDroppingMorph:event:inMorph: dragPassengerFor:inMorph: dragTransferTypeForMorph: dropDestinationDirectory:event: isDirectoryList: primitiveCopyFileNamed:to: wantsDroppedMorph:event:inMorph:) ('file list' fileList fileListIndex fileListIndex: fileName) ('file list menu' browseRecentChanges dirAndFileName fileContentsMenu:shifted: fileListMenu: fileSelectedMenu: fullFileListMenu:shifted: fullNameArguments itemsForAnyFile itemsForFile: itemsForNoFile myServicesForFile:suffix: noFileSelectedMenu: offerAllFileOptions suffixOfSelectedFile) ('file menu action' addNew:byEvaluating: addNewDirectory addNewFile compressFile deleteFile editFile get getHex renameFile sortByDate sortByName sortBySize spawn: templateFile) ('initialization' blockToGetArgArrayFrom: buttonSelectorsToSuppress directory: dynamicButtonServices labelString modelSleep modelWakeUp optionalButtonHeight optionalButtonRow optionalButtonServices optionalButtonSpecs optionalButtonView release selectorsWithArgsSelector serviceSelectorsForButtonPane setFileStream: universalButtonServices updateButtonRow) ('menu messages' browseChanges copyName) ('obsolete methods' addFileToZip browseFiles loadCRDictionary loadCRDisplayProperties openModelintoAlice) ('own services' serviceAddFileToZip serviceAddNewDirectory serviceAddNewFile serviceAllFileOptions serviceBroadcastUpdate serviceBrowseCodeFiles serviceCompressFile serviceCopyName serviceDeleteFile serviceGet serviceGetHex serviceRenameFile serviceSortByDate serviceSortByName serviceSortBySize servicesFromSelectorSpecs:) ('to be transformed in registration' askServerInfo perform:orSendTo: putUpdate: removeServer volumeMenu:) ('updating' update:) ('volume list and pattern' deleteDirectory directory fileNameFormattedFrom:sizePad: listForPattern: pattern pattern: veryDeepFixupWith: volumeList volumeListIndex volumeListIndex:) ('private' addPath: contents defaultContents entriesMatching: fileNameFromFormattedItem: folderString fullName isFileSelected listForPatterns: put: readContentsBrief: readContentsHex: readServerBrief recentDirs registeredFileReaderClasses resort: sortBlock sortingByDate sortingByName sortingBySize updateFileList) !