FileSelectionBrowser.st
author Claus Gittinger <cg@exept.de>
Sat, 21 Jul 2012 18:58:03 +0200
changeset 2898 c7f6c498df6a
parent 2777 eb16ea45aa92
child 3197 239fe0968d06
permissions -rw-r--r--
category of:15 methods
     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                     '*.png ; *.gif ; *.bmp ; *.tif ; *.tiff ; *.xpm ; *.xbm ; *.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                     '*.png ; *.gif ; *.bmp ; *.tif ; *.tiff ; *.xpm ; *.xbm'
   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           #bounds: #(#Rectangle 18 51 618 401)
   247         )
   248         #component: 
   249        #(#SpecCollection
   250           #collection: #(
   251            #(#VariableHorizontalPanelSpec
   252               #name: 'panel'
   253               #layout: #(#LayoutFrame 0 0.0 0 0.0 0 1.0 -40 1.0)
   254               #component: 
   255              #(#SpecCollection
   256                 #collection: #(
   257                  #(#ViewSpec
   258                     #name: 'view1'
   259                     #component: 
   260                    #(#SpecCollection
   261                       #collection: #(
   262                        #(#FileSelectionTreeSpec
   263                           #name: 'directoryTreeView'
   264                           #layout: #(#LayoutFrame 0 0.0 0 0.0 0 1.0 -25 1.0)
   265                           #model: #selectionOfDirectory
   266                           #menu: #treeMenu
   267                           #hasHorizontalScrollBar: true
   268                           #hasVerticalScrollBar: true
   269                           #miniScrollerHorizontal: true
   270                           #showDirectoryIndicatorForRoot: false
   271                           #showDirectoryIndicator: true
   272                           #valueChangeSelector: #readDirectory
   273                           #hierarchicalList: #rootOfDirectory
   274                           #highlightMode: #line
   275                           #itemClass: 'Directory'
   276                         )
   277                        #(#InputFieldSpec
   278                           #name: 'directoryInputField'
   279                           #layout: #(#LayoutFrame 2 0.0 -22 1 0 1.0 0 1)
   280                           #model: #selectionOfDirectory
   281                           #immediateAccept: false
   282                           #acceptOnPointerLeave: false
   283                         )
   284                        )
   285                      
   286                     )
   287                   )
   288                  #(#ViewSpec
   289                     #name: 'view2'
   290                     #component: 
   291                    #(#SpecCollection
   292                       #collection: #(
   293                        #(#InputFieldSpec
   294                           #name: 'EditField'
   295                           #layout: #(#LayoutFrame 1 0.0 -22 1 -2 1.0 0 1)
   296                           #model: #valueOfFileName
   297                           #acceptOnReturn: false
   298                           #acceptOnTab: false
   299                           #acceptOnPointerLeave: false
   300                         )
   301                        #(#SubCanvasSpec
   302                           #name: 'subCanvas1'
   303                           #layout: #(#LayoutFrame 1 0.0 0 0.0 0 1.0 -25 1.0)
   304                           #clientHolder: #directoryView
   305                         )
   306                        )
   307                      
   308                     )
   309                   )
   310                  )
   311                
   312               )
   313               #handles: #(#Any 0.5 1.0)
   314             )
   315            #(#UISubSpecification
   316               #name: 'SubSpecification'
   317               #layout: #(#LayoutFrame 2 0.0 -32 1 0 1.0 0 1.0)
   318               #majorKey: #ToolApplicationModel
   319               #minorKey: #windowSpecForCommitWithoutChannels
   320             )
   321            )
   322          
   323         )
   324       )
   325 ! !
   326 
   327 !FileSelectionBrowser class methodsFor:'menu specs'!
   328 
   329 treeMenu
   330     "This resource specification was automatically generated
   331      by the MenuEditor of ST/X."
   332 
   333     "Do not manually edit this!! If it is corrupted,
   334      the MenuEditor may not be able to read the specification."
   335 
   336     "
   337      MenuEditor new openOnClass:FileSelectionBrowser andSelector:#treeMenu
   338      (Menu new fromLiteralArrayEncoding:(FileSelectionBrowser treeMenu)) startUp
   339     "
   340 
   341     <resource: #menu>
   342 
   343     ^ 
   344      #(#Menu
   345         #(
   346          #(#MenuItem
   347             #label: 'Goto Home Directory'
   348             #translateLabel: true
   349             #value: #menuGotoHomeDirectory
   350           )
   351          #(#MenuItem
   352             #label: 'Goto Default Directory'
   353             #translateLabel: true
   354             #value: #menuGotoDefaultDirectory
   355           )
   356          #(#MenuItem
   357             #label: '-'
   358           )
   359          #(#MenuItem
   360             #label: 'Create directory...'
   361             #translateLabel: true
   362             #value: #menuCreateDirectory
   363           )
   364          #(#MenuItem
   365             #label: '-'
   366           )
   367          #(#MenuItem
   368             #label: 'Update'
   369             #translateLabel: true
   370             #value: #menuUpdate
   371           )
   372          )
   373         nil
   374         nil
   375       )
   376 ! !
   377 
   378 !FileSelectionBrowser methodsFor:'accessing'!
   379 
   380 directory: aDirectory
   381 
   382     directory := (aDirectory ? Filename currentDirectory) asFilename asAbsoluteFilename pathName
   383 
   384     "Modified: / 17.8.1998 / 10:15:53 / cg"
   385 !
   386 
   387 directoryView
   388     "return the directory view on the right side (a subcanvas)"
   389 
   390     ^directoryView ? (directoryView := DirectoryView new)
   391 
   392     "Modified: / 23.9.1998 / 16:46:50 / cg"
   393 !
   394 
   395 fileName: aFileName
   396     |prevDir|
   397 
   398     self valueOfFileName value: (aFileName ? '') asFilename baseName.
   399     prevDir := directory.
   400     directory := directory ? ((aFileName ? '') asFilename asAbsoluteFilename directoryName).
   401 
   402     "/ on systems with volumes, we might have to update the root here.
   403     (prevDir isNil
   404     or:[directory asFilename volume ~= prevDir asFilename volume]) ifTrue:[
   405         self setRootForFile:directory asFilename.
   406     ].
   407 
   408     "Modified: / 24.9.1998 / 23:41:08 / cg"
   409 !
   410 
   411 listOfFileFilters: anArray
   412 
   413     listOfFileFilters := anArray
   414 ! !
   415 
   416 !FileSelectionBrowser methodsFor:'accessing-views'!
   417 
   418 directoryInputField
   419 
   420     ^self componentAt: #directoryInputField
   421 !
   422 
   423 directoryTreeView
   424 
   425     ^self componentAt: #directoryTreeView
   426 ! !
   427 
   428 !FileSelectionBrowser methodsFor:'aspects'!
   429 
   430 rootOfDirectory
   431 
   432     |holder|
   433     (holder := builder bindingAt:#rootOfDirectory) isNil ifTrue:[
   434         builder 
   435             aspectAt:#rootOfDirectory 
   436             put: (holder :=  Filename rootDirectory name asValue).
   437     ].
   438     ^ holder
   439 
   440     "Modified: / 5.10.1998 / 12:46:10 / cg"
   441 !
   442 
   443 selectionOfDirectory
   444 
   445     |holder|
   446     (holder := builder bindingAt:#selectionOfDirectory) isNil ifTrue:[
   447         builder aspectAt:#selectionOfDirectory put: (holder := ValueHolder new)
   448     ].
   449     ^ holder
   450 
   451 !
   452 
   453 setRootForFile:aFilename
   454     |f root parent|
   455 
   456     f := aFilename asFilename.
   457     root := Filename rootDirectoryOnVolume:f volume.
   458     self directory:aFilename.
   459 
   460     "/ on some systems, the root itself is not readable,
   461     "/ but subdirs are (WIN32-network drives and VMS)
   462     "/ to avoid trouble in the treeView, search for the
   463     "/ last readable directory and fake that as the trees root.
   464 
   465     (root exists and:[root isDirectory and:[root isReadable]])
   466     ifFalse:[
   467         "/ search backward from aFilename for the last readable dir.
   468         root := f.
   469         parent := root directory.
   470         [parent ~= root
   471          and:[parent exists 
   472          and:[parent isDirectory 
   473          and:[parent isReadable]]]]
   474         whileTrue:[
   475             root := parent.
   476             parent := root directory.
   477         ].
   478     ].
   479 
   480     self rootOfDirectory value:root pathName
   481 
   482     "Created: / 23.9.1998 / 16:36:28 / cg"
   483     "Modified: / 5.10.1998 / 12:46:06 / cg"
   484 !
   485 
   486 valueOfFileName
   487 
   488     |holder|
   489     (holder := builder bindingAt:#valueOfFileName) isNil ifTrue:[
   490         builder aspectAt:#valueOfFileName put:(holder :=  ValueHolder new).
   491     ].
   492     ^ holder
   493 ! !
   494 
   495 !FileSelectionBrowser methodsFor:'callbacks'!
   496 
   497 fileDoubleClicked: aFileName
   498 
   499     self valueOfFileName value: aFileName.
   500     accept value: true.
   501     self closeRequest
   502 !
   503 
   504 menuCreateDirectory
   505     |newSubDirName currentDir|
   506 
   507     currentDir := self selectionOfDirectory value.
   508     currentDir isNil ifTrue:[
   509         self warn:'No directory selected.'.
   510         ^ self
   511     ].
   512     newSubDirName := Dialog 
   513                         request:(resources 
   514                                     stringWithCRs:'Create new directory in\\%1: ' 
   515                                     with:(currentDir asFilename pathName allBold)).
   516     (currentDir asFilename construct:newSubDirName) makeDirectory.
   517     self menuUpdate
   518 !
   519 
   520 menuGotoDefaultDirectory
   521     self selectionOfDirectory value:(Filename defaultDirectory pathName)
   522 !
   523 
   524 menuGotoHomeDirectory
   525     self selectionOfDirectory value:(Filename homeDirectory pathName)
   526 !
   527 
   528 menuUpdate
   529     (self componentAt:#directoryTreeView) monitorCycle.
   530 !
   531 
   532 readDirectory
   533     self directoryTreeView selection notNil ifTrue: [
   534         directoryView directory: self selectionOfDirectory value.
   535         directoryView readDirectory.  
   536         self class lastSelection notNil ifTrue: [self class lastSelection: self selectionOfDirectory value]
   537     ]
   538 
   539     "Modified: / 24.9.1998 / 21:58:50 / cg"
   540 ! !
   541 
   542 !FileSelectionBrowser methodsFor:'misc'!
   543 
   544 entryCompletion
   545     |completedDirectory f dir treeView inputField|
   546 
   547     treeView := self directoryTreeView.
   548     inputField := self directoryInputField.
   549 
   550     f := inputField contents.
   551     f asFilename isRootDirectory ifTrue:[
   552         dir := f.
   553     ] ifFalse:[
   554         dir := f asFilename directoryName.
   555     ].
   556 
   557     completedDirectory := Filename 
   558         filenameCompletionFor:f
   559         directory:dir
   560         directoriesOnly:true 
   561         filesOnly:false 
   562         ifMultiple:
   563             [:dir | 
   564                 treeView selection notNil ifTrue:[
   565                     treeView selectedNodeExpand: true
   566                 ]
   567             ].
   568 
   569     completedDirectory asFilename exists ifTrue:[
   570         "/ volume changed ... (win32 or VMS)
   571 "/        completedDirectory asFilename volume ~= directory asFilename volume ifTrue:[
   572 "/        ].
   573         completedDirectory asFilename volume ~= treeView scrolledView directory asFilename volume ifTrue:[
   574             treeView scrolledView directory:completedDirectory asFilename volume
   575         ].
   576         treeView selectPathname: completedDirectory.
   577         inputField contents: completedDirectory.
   578         self readDirectory
   579     ] ifFalse: [
   580         inputField flash
   581     ]
   582 
   583     "Created: / 24.9.1998 / 21:33:37 / cg"
   584     "Modified: / 24.9.1998 / 22:20:23 / cg"
   585 ! !
   586 
   587 !FileSelectionBrowser methodsFor:'startup & release'!
   588 
   589 closeCancel
   590 
   591     directoryView release.
   592     super closeCancel
   593 !
   594 
   595 closeRequest
   596 
   597     directoryView release.
   598     super closeRequest
   599 
   600 !
   601 
   602 open
   603     super open.
   604 
   605     "return the selected file or nil"
   606     accept value ifTrue:[
   607         ^ (self selectionOfDirectory value ? '') asFilename 
   608                 constructString:(self valueOfFileName value ? '')
   609     ].
   610     ^ nil
   611 
   612     "Modified: / 17.8.1998 / 10:15:55 / cg"
   613 !
   614 
   615 postBuildWith:aBuilder
   616     |nm file|
   617 
   618     directoryView listOfFileFilters: listOfFileFilters ? #('*').
   619     directoryView fileSelectAction: [:aFileName |self valueOfFileName value: aFileName asFilename baseName].
   620     directoryView fileDoubleClickAction: [:aFileName |self fileDoubleClicked: aFileName asFilename baseName].
   621     directoryView fileFilterSelectAction: [:fileFilter|
   622 "/        CG: obscure code - isn't the code below the same as ?
   623 "/        self valueOfFileName value:((self valueOfFileName value ? 'unknown') 
   624 "/                                    asFilename
   625 "/                                        withSuffix:(fileFilter asFilename suffix))
   626         self valueOfFileName value: (
   627             ((self valueOfFileName value ? 'unknown') readStream upTo: $.), '.',
   628             (fileFilter copy reverse readStream upTo: $.) reverse)
   629     ]. 
   630     nm := directory.
   631     nm isNil ifTrue:[
   632         nm := self class lastSelection.
   633         nm isNil ifTrue:[
   634             nm := Filename currentDirectory asAbsoluteFilename name.
   635         ].
   636     ].
   637 
   638     self directoryTreeView selectPathname:nm.
   639 
   640     self directoryInputField 
   641         entryCompletionBlock:[:f| self entryCompletion].
   642 
   643     file := self valueOfFileName value.
   644     directoryView selectionOfFile value: 
   645         (directoryView listOfFiles 
   646             detect: [:row | row baseName = file] 
   647             ifNone: nil).
   648 
   649     super postBuildWith:aBuilder
   650 
   651     "Modified: / 24.9.1998 / 23:41:29 / cg"
   652 ! !
   653 
   654 !FileSelectionBrowser class methodsFor:'documentation'!
   655 
   656 version
   657     ^ '$Header$'
   658 !
   659 
   660 version_CVS
   661     ^ '$Header$'
   662 ! !