FileSelectionBrowser.st
author Patrik Svestka <patrik.svestka@gmail.com>
Wed, 14 Nov 2018 12:07:51 +0100
branchjv
changeset 3630 5e718e0a754e
parent 3252 b5b2f185aa98
permissions -rw-r--r--
Issue #239: Fix all Smalltak/X source files to be in unicode (UTF8 without BOM) and prefixed by "{ Encoding: utf8 }" when any unicode character is present

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