FileSelectionBrowser.st
author Claus Gittinger <cg@exept.de>
Wed, 29 Jul 2009 20:02:02 +0200
changeset 2570 4e663bc64364
parent 2450 ede256dd19a1
child 2594 2e3885af5ea3
permissions -rw-r--r--
changed #requestPackage
     1 "
     2  COPYRIGHT (c) 1997 by eXept Software AG
     3               All Rights Reserved
     4 
     5  This software is furnished under a license and may be used
     6  only in accordance with the terms of that license and with the
     7  inclusion of the above copyright notice. This software may not
     8  be provided or otherwise made available to, or used by, any
     9  other person. No title to or ownership of the software is
    10  hereby transferred.
    11 "
    12 "{ Package: 'stx:libtool2' }"
    13 
    14 SelectionBrowser subclass:#FileSelectionBrowser
    15 	instanceVariableNames:'selectedFileFilter directoryView listOfFileFilters directory'
    16 	classVariableNames:''
    17 	poolDictionaries:''
    18 	category:'Interface-Dialogs'
    19 !
    20 
    21 !FileSelectionBrowser class methodsFor:'documentation'!
    22 
    23 copyright
    24 "
    25  COPYRIGHT (c) 1997 by eXept Software AG
    26               All Rights Reserved
    27 
    28  This software is furnished under a license and may be used
    29  only in accordance with the terms of that license and with the
    30  inclusion of the above copyright notice. This software may not
    31  be provided or otherwise made available to, or used by, any
    32  other person. No title to or ownership of the software is
    33  hereby transferred.
    34 "
    35 
    36 
    37 !
    38 
    39 documentation
    40 "
    41     The FileSelectionBrowser allows you to browse in file directories
    42     and to select files in order to load file contents or to save
    43     something to files.
    44 
    45     [start with:]
    46         FileSelectionBrowser open
    47 
    48     [author:]
    49         Thomas Zwick, eXept Software AG
    50 "
    51 ! !
    52 
    53 !FileSelectionBrowser class methodsFor:'instance creation'!
    54 
    55 request: aTitle fileName: aFileName inDirectory: dir withFileFilters: fileFilters
    56     "ask for a file in some directory,
    57      using a fileFilter (list of mathcPatterns).
    58      Initial selection is aFileName.
    59      return the pathName or nil if canceled."
    60 
    61     ^self new
    62         title: aTitle;
    63         fileName: aFileName;
    64         directory: dir;
    65         listOfFileFilters: fileFilters;
    66         open
    67 
    68     "
    69      self 
    70          request: 'Select Your Profile File' 
    71          fileName: '.profile' 
    72          inDirectory: Filename homeDirectory 
    73          withFileFilters: #('.*')
    74     "
    75 
    76     "Modified: / 17.8.1998 / 10:15:50 / cg"
    77 !
    78 
    79 request:aTitle fileName:aFileName withFileFilters:fileFilters
    80     "ask for a file in some directory,
    81      using a fileFilter (list of mathcPatterns).
    82      Initial selection is aFileName.
    83      return the pathName or nil if canceled."
    84 
    85     ^ self new
    86         title: aTitle;
    87         fileName: aFileName;
    88         listOfFileFilters: fileFilters;
    89         open
    90 
    91     "
    92      self 
    93          request: 'Select Your Profile File' 
    94          fileName: '/etc/fstab' 
    95          withFileFilters: #('*')  
    96     "
    97 
    98     "Modified: / 17.8.1998 / 10:15:50 / cg"
    99 !
   100 
   101 request:aTitle inDirectory:aPath withFileFilters:fileFilters 
   102     "ask for a file in some directory,
   103      using a fileFilter (list of mathcPatterns)
   104      return the pathName or nil if canceled."
   105 
   106     ^ (self new)
   107         title:aTitle;
   108         directory:aPath;
   109         listOfFileFilters:fileFilters;
   110         open
   111 
   112     "
   113      self 
   114          request: 'Select A File' 
   115          inDirectory: '/etc' 
   116          withFileFilters: #('*.conf')
   117     "
   118 
   119     "Modified: / 17.8.1998 / 10:15:50 / cg"
   120 !
   121 
   122 request:aTitle pathName:aPath withFileFilters:fileFilters 
   123     "ask for a file in some directory,
   124      using a fileFilter (list of mathcPatterns)
   125      return the pathName or nil if canceled.
   126      Obsolete - for backward compatibility."
   127 
   128     ^ self
   129         request:aTitle inDirectory:aPath withFileFilters:fileFilters
   130 
   131     "
   132      self 
   133          request: 'Select A File' 
   134          pathName: '/etc' 
   135          withFileFilters: #('*.conf')
   136     "
   137 
   138     "Modified: / 17.8.1998 / 10:15:50 / cg"
   139 !
   140 
   141 request:aTitle withFileFilters:fileFilters 
   142     "ask for a file in the current directory,
   143      using a fileFilter (list of mathcPatterns)
   144      return the pathName or nil if canceled"
   145 
   146     ^ (self new)
   147         title:aTitle;
   148         listOfFileFilters:fileFilters;
   149         open
   150 
   151     "
   152      self request:'Select A File' withFileFilters:#('.*')
   153      self request:'Select A File' withFileFilters:#('*.mak;*.st')
   154     "
   155 
   156     "Modified: / 17.8.1998 / 10:15:49 / cg"
   157 !
   158 
   159 requestFileName
   160     "ask for a file in the current directory;
   161      return the pathName or nil if canceled"
   162 
   163     ^ self new 
   164         title:'Select A File';
   165         open
   166 
   167     "
   168      self requestFileName
   169     "
   170 
   171     "Modified: / 17.8.1998 / 10:15:48 / cg"
   172 !
   173 
   174 requestFileNameInDirectory:aPath
   175     "ask for a file in a directory;
   176      return the pathName or nil if canceled"
   177 
   178     ^ self new 
   179         title:'Select A File'; 
   180         directory:aPath; 
   181         open
   182 
   183     "
   184      self requestFileNameInDirectory:'/etc' 
   185     "
   186 
   187     "Modified: / 17.8.1998 / 10:15:48 / cg"
   188 ! !
   189 
   190 !FileSelectionBrowser class methodsFor:'accessing'!
   191 
   192 loadImageFileNameFilters
   193     ^ OrderedCollection 
   194         withAll: #(
   195                     '*.xpm ; *.xbm ; *.gif ; *.tif ; *.tiff ; *.bmp ; *.jpeg ; *.jpg'
   196                     '*'
   197                   )
   198 
   199     "Modified: / 12.9.1998 / 17:23:42 / cg"
   200 !
   201 
   202 projectFileNameFilters
   203     ^Array withAll: #(
   204                       '*.st ; *.*o ; *.s ; *.c ; Make* ; *.project'
   205                       '*'
   206                      )
   207 
   208     "Modified: / 12.9.1998 / 17:23:22 / cg"
   209 !
   210 
   211 saveImageFileNameFilters
   212     ^ OrderedCollection 
   213         withAll: #(
   214                     '*.xpm ; *.xbm ; *.gif ; *.tif ; *.tiff ; *.bmp'
   215                     '*'
   216                   )
   217 
   218     "Modified: / 12.9.1998 / 17:23:54 / cg"
   219 ! !
   220 
   221 !FileSelectionBrowser class methodsFor:'interface specs'!
   222 
   223 windowSpec
   224     "This resource specification was automatically generated
   225      by the UIPainter of ST/X."
   226 
   227     "Do not manually edit this!! If it is corrupted,
   228      the UIPainter may not be able to read the specification."
   229 
   230     "
   231      UIPainter new openOnClass:FileSelectionBrowser andSelector:#windowSpec
   232      FileSelectionBrowser new openInterface:#windowSpec
   233      FileSelectionBrowser open
   234     "
   235 
   236     <resource: #canvas>
   237 
   238     ^ 
   239      #(#FullSpec
   240         #name: #windowSpec
   241         #window: 
   242        #(#WindowSpec
   243           #label: 'File Selection Browser'
   244           #name: 'File Selection Browser'
   245           #min: #(#Point 10 10)
   246           #max: #(#Point 1152 900)
   247           #bounds: #(#Rectangle 18 51 618 401)
   248         )
   249         #component: 
   250        #(#SpecCollection
   251           #collection: #(
   252            #(#VariableHorizontalPanelSpec
   253               #name: 'panel'
   254               #layout: #(#LayoutFrame 0 0.0 0 0.0 0 1.0 -40 1.0)
   255               #component: 
   256              #(#SpecCollection
   257                 #collection: #(
   258                  #(#ViewSpec
   259                     #name: 'view1'
   260                     #component: 
   261                    #(#SpecCollection
   262                       #collection: #(
   263                        #(#FileSelectionTreeSpec
   264                           #name: 'directoryTreeView'
   265                           #layout: #(#LayoutFrame 0 0.0 0 0.0 0 1.0 -25 1.0)
   266                           #model: #selectionOfDirectory
   267                           #menu: #treeMenu
   268                           #hasHorizontalScrollBar: true
   269                           #hasVerticalScrollBar: true
   270                           #miniScrollerHorizontal: true
   271                           #showDirectoryIndicatorForRoot: false
   272                           #showDirectoryIndicator: true
   273                           #valueChangeSelector: #readDirectory
   274                           #hierarchicalList: #rootOfDirectory
   275                           #highlightMode: #line
   276                           #itemClass: 'Directory'
   277                         )
   278                        #(#InputFieldSpec
   279                           #name: 'directoryInputField'
   280                           #layout: #(#LayoutFrame 2 0.0 -22 1 0 1.0 0 1)
   281                           #model: #selectionOfDirectory
   282                           #immediateAccept: false
   283                           #acceptOnPointerLeave: false
   284                         )
   285                        )
   286                      
   287                     )
   288                   )
   289                  #(#ViewSpec
   290                     #name: 'view2'
   291                     #component: 
   292                    #(#SpecCollection
   293                       #collection: #(
   294                        #(#InputFieldSpec
   295                           #name: 'EditField'
   296                           #layout: #(#LayoutFrame 1 0.0 -22 1 -2 1.0 0 1)
   297                           #model: #valueOfFileName
   298                           #acceptOnReturn: false
   299                           #acceptOnTab: false
   300                           #acceptOnPointerLeave: false
   301                         )
   302                        #(#SubCanvasSpec
   303                           #name: 'subCanvas1'
   304                           #layout: #(#LayoutFrame 1 0.0 0 0.0 0 1.0 -25 1.0)
   305                           #clientHolder: #directoryView
   306                         )
   307                        )
   308                      
   309                     )
   310                   )
   311                  )
   312                
   313               )
   314               #handles: #(#Any 0.5 1.0)
   315             )
   316            #(#UISubSpecification
   317               #name: 'SubSpecification'
   318               #layout: #(#LayoutFrame 2 0.0 -32 1 0 1.0 0 1.0)
   319               #majorKey: #ToolApplicationModel
   320               #minorKey: #windowSpecForCommitWithoutChannels
   321             )
   322            )
   323          
   324         )
   325       )
   326 ! !
   327 
   328 !FileSelectionBrowser class methodsFor:'menu specs'!
   329 
   330 treeMenu
   331     "This resource specification was automatically generated
   332      by the MenuEditor of ST/X."
   333 
   334     "Do not manually edit this!! If it is corrupted,
   335      the MenuEditor may not be able to read the specification."
   336 
   337     "
   338      MenuEditor new openOnClass:FileSelectionBrowser andSelector:#treeMenu
   339      (Menu new fromLiteralArrayEncoding:(FileSelectionBrowser treeMenu)) startUp
   340     "
   341 
   342     <resource: #menu>
   343 
   344     ^ 
   345      #(#Menu
   346         #(
   347          #(#MenuItem
   348             #label: 'Goto Home Directory'
   349             #translateLabel: true
   350             #value: #menuGotoHomeDirectory
   351           )
   352          #(#MenuItem
   353             #label: 'Goto Default Directory'
   354             #translateLabel: true
   355             #value: #menuGotoDefaultDirectory
   356           )
   357          #(#MenuItem
   358             #label: '-'
   359           )
   360          #(#MenuItem
   361             #label: 'Create directory...'
   362             #translateLabel: true
   363             #value: #menuCreateDirectory
   364           )
   365          #(#MenuItem
   366             #label: '-'
   367           )
   368          #(#MenuItem
   369             #label: 'Update'
   370             #translateLabel: true
   371             #value: #menuUpdate
   372           )
   373          )
   374         nil
   375         nil
   376       )
   377 ! !
   378 
   379 !FileSelectionBrowser methodsFor:'accessing'!
   380 
   381 directory: aDirectory
   382 
   383     directory := (aDirectory ? Filename currentDirectory) asFilename asAbsoluteFilename pathName
   384 
   385     "Modified: / 17.8.1998 / 10:15:53 / cg"
   386 !
   387 
   388 directoryView
   389     "return the directory view on the right side (a subcanvas)"
   390 
   391     ^directoryView ? (directoryView := DirectoryView new)
   392 
   393     "Modified: / 23.9.1998 / 16:46:50 / cg"
   394 !
   395 
   396 fileName: aFileName
   397     |prevDir|
   398 
   399     self valueOfFileName value: (aFileName ? '') asFilename baseName.
   400     prevDir := directory.
   401     directory := directory ? ((aFileName ? '') asFilename asAbsoluteFilename directoryName).
   402 
   403     "/ on systems with volumes, we might have to update the root here.
   404     (prevDir isNil
   405     or:[directory asFilename volume ~= prevDir asFilename volume]) ifTrue:[
   406         self setRootForFile:directory asFilename.
   407     ].
   408 
   409     "Modified: / 24.9.1998 / 23:41:08 / cg"
   410 !
   411 
   412 listOfFileFilters: anArray
   413 
   414     listOfFileFilters := anArray
   415 ! !
   416 
   417 !FileSelectionBrowser methodsFor:'accessing-views'!
   418 
   419 directoryInputField
   420 
   421     ^self componentAt: #directoryInputField
   422 !
   423 
   424 directoryTreeView
   425 
   426     ^self componentAt: #directoryTreeView
   427 ! !
   428 
   429 !FileSelectionBrowser methodsFor:'aspects'!
   430 
   431 rootOfDirectory
   432 
   433     |holder|
   434     (holder := builder bindingAt:#rootOfDirectory) isNil ifTrue:[
   435         builder 
   436             aspectAt:#rootOfDirectory 
   437             put: (holder :=  Filename rootDirectory name asValue).
   438     ].
   439     ^ holder
   440 
   441     "Modified: / 5.10.1998 / 12:46:10 / cg"
   442 !
   443 
   444 selectionOfDirectory
   445 
   446     |holder|
   447     (holder := builder bindingAt:#selectionOfDirectory) isNil ifTrue:[
   448         builder aspectAt:#selectionOfDirectory put: (holder := ValueHolder new)
   449     ].
   450     ^ holder
   451 
   452 !
   453 
   454 setRootForFile:aFilename
   455     |f root parent|
   456 
   457     f := aFilename asFilename.
   458     root := Filename rootDirectoryOnVolume:f volume.
   459     self directory:aFilename.
   460 
   461     "/ on some systems, the root itself is not readable,
   462     "/ but subdirs are (WIN32-network drives and VMS)
   463     "/ to avoid trouble in the treeView, search for the
   464     "/ last readable directory and fake that as the trees root.
   465 
   466     (root exists and:[root isDirectory and:[root isReadable]])
   467     ifFalse:[
   468         "/ search backward from aFilename for the last readable dir.
   469         root := f.
   470         parent := root directory.
   471         [parent ~= root
   472          and:[parent exists 
   473          and:[parent isDirectory 
   474          and:[parent isReadable]]]]
   475         whileTrue:[
   476             root := parent.
   477             parent := root directory.
   478         ].
   479     ].
   480 
   481     self rootOfDirectory value:root pathName
   482 
   483     "Created: / 23.9.1998 / 16:36:28 / cg"
   484     "Modified: / 5.10.1998 / 12:46:06 / cg"
   485 !
   486 
   487 valueOfFileName
   488 
   489     |holder|
   490     (holder := builder bindingAt:#valueOfFileName) isNil ifTrue:[
   491         builder aspectAt:#valueOfFileName put:(holder :=  ValueHolder new).
   492     ].
   493     ^ holder
   494 ! !
   495 
   496 !FileSelectionBrowser methodsFor:'callbacks'!
   497 
   498 fileDoubleClicked: aFileName
   499 
   500     self valueOfFileName value: aFileName.
   501     accept value: true.
   502     self closeRequest
   503 !
   504 
   505 menuCreateDirectory
   506     |newSubDirName currentDir|
   507 
   508     currentDir := self selectionOfDirectory value.
   509     currentDir isNil ifTrue:[
   510         self warn:'No directory selected.'.
   511         ^ self
   512     ].
   513     newSubDirName := Dialog 
   514                         request:(resources 
   515                                     stringWithCRs:'Create new directory in\\%1: ' 
   516                                     with:(currentDir asFilename pathName allBold)).
   517     (currentDir asFilename construct:newSubDirName) makeDirectory.
   518     self menuUpdate
   519 !
   520 
   521 menuGotoDefaultDirectory
   522     self selectionOfDirectory value:(Filename defaultDirectory pathName)
   523 !
   524 
   525 menuGotoHomeDirectory
   526     self selectionOfDirectory value:(Filename homeDirectory pathName)
   527 !
   528 
   529 menuUpdate
   530     (self componentAt:#directoryTreeView) monitorCycle.
   531 !
   532 
   533 readDirectory
   534     self directoryTreeView selection notNil ifTrue: [
   535         directoryView directory: self selectionOfDirectory value.
   536         directoryView readDirectory.  
   537         self class lastSelection notNil ifTrue: [self class lastSelection: self selectionOfDirectory value]
   538     ]
   539 
   540     "Modified: / 24.9.1998 / 21:58:50 / cg"
   541 ! !
   542 
   543 !FileSelectionBrowser methodsFor:'misc'!
   544 
   545 entryCompletion
   546     |completedDirectory f dir treeView inputField|
   547 
   548     treeView := self directoryTreeView.
   549     inputField := self directoryInputField.
   550 
   551     f := inputField contents.
   552     f asFilename isRootDirectory ifTrue:[
   553         dir := f.
   554     ] ifFalse:[
   555         dir := f asFilename directoryName.
   556     ].
   557 
   558     completedDirectory := Filename 
   559         filenameCompletionFor:f
   560         directory:dir
   561         directoriesOnly:true 
   562         filesOnly:false 
   563         ifMultiple:
   564             [:dir | 
   565                 treeView selection notNil ifTrue:[
   566                     treeView selectedNodeExpand: true
   567                 ]
   568             ].
   569 
   570     completedDirectory asFilename exists ifTrue:[
   571         "/ volume changed ... (win32 or VMS)
   572 "/        completedDirectory asFilename volume ~= directory asFilename volume ifTrue:[
   573 "/        ].
   574         completedDirectory asFilename volume ~= treeView scrolledView directory asFilename volume ifTrue:[
   575             treeView scrolledView directory:completedDirectory asFilename volume
   576         ].
   577         treeView selectPathname: completedDirectory.
   578         inputField contents: completedDirectory.
   579         self readDirectory
   580     ] ifFalse: [
   581         inputField flash
   582     ]
   583 
   584     "Created: / 24.9.1998 / 21:33:37 / cg"
   585     "Modified: / 24.9.1998 / 22:20:23 / cg"
   586 ! !
   587 
   588 !FileSelectionBrowser methodsFor:'startup & release'!
   589 
   590 closeCancel
   591 
   592     directoryView release.
   593     super closeCancel
   594 !
   595 
   596 closeRequest
   597 
   598     directoryView release.
   599     super closeRequest
   600 
   601 !
   602 
   603 open
   604     super open.
   605 
   606     "return the selected file or nil"
   607     accept value ifTrue:[
   608         ^ (self selectionOfDirectory value ? '') asFilename 
   609                 constructString:(self valueOfFileName value ? '')
   610     ].
   611     ^ nil
   612 
   613     "Modified: / 17.8.1998 / 10:15:55 / cg"
   614 !
   615 
   616 postBuildWith:aBuilder
   617     |nm file|
   618 
   619     directoryView listOfFileFilters: listOfFileFilters ? #('*').
   620     directoryView fileSelectAction: [:aFileName |self valueOfFileName value: aFileName asFilename baseName].
   621     directoryView fileDoubleClickAction: [:aFileName |self fileDoubleClicked: aFileName asFilename baseName].
   622     directoryView fileFilterSelectAction: [:fileFilter|
   623 "/        CG: obscure code - isn't the code below the same as ?
   624 "/        self valueOfFileName value:((self valueOfFileName value ? 'unknown') 
   625 "/                                    asFilename
   626 "/                                        withSuffix:(fileFilter asFilename suffix))
   627         self valueOfFileName value: (
   628             ((self valueOfFileName value ? 'unknown') readStream upTo: $.), '.',
   629             (fileFilter copy reverse readStream upTo: $.) reverse)
   630     ]. 
   631     nm := directory.
   632     nm isNil ifTrue:[
   633         nm := self class lastSelection.
   634         nm isNil ifTrue:[
   635             nm := Filename currentDirectory asAbsoluteFilename name.
   636         ].
   637     ].
   638 
   639     self directoryTreeView selectPathname:nm.
   640 
   641     self directoryInputField 
   642         entryCompletionBlock:[:f| self entryCompletion].
   643 
   644     file := self valueOfFileName value.
   645     directoryView selectionOfFile value: 
   646         (directoryView listOfFiles 
   647             detect: [:row | row baseName = file] 
   648             ifNone: nil).
   649 
   650     super postBuildWith:aBuilder
   651 
   652     "Modified: / 24.9.1998 / 23:41:29 / cg"
   653 ! !
   654 
   655 !FileSelectionBrowser class methodsFor:'documentation'!
   656 
   657 version
   658     ^ '$Header$'
   659 ! !