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