Riad KACED wrote, on 05/12/08 02:14:
> Hi Andrew,
>
> I think it is worth re-posting it again. The original one seems to end
> in a black hole I'm afraid ;-)
>
> Riad.
Rather than attaching, I'll paste in the code. I'll do this in two posts.
First
the main code which does the work.
/* abSelectFile.il
Author A.D.Beckett
Group Custom IC, Cadence Design Systems Ltd
Machine SUN
Date Dec 07, 1993
Modified Jan 21, 2000
By A.D.Beckett
File/Directory Browser
In order to use this, you need to do three things:
1. Have a button on your form which synchronises your form to
the select file form. This is done by having a callback
on the button which invokes:
(abSyncWithSelectFile yourForm 'yourField [t])
The optional t indicates that it should just browse directories.
2. The field being sync'd needs a callback so that values typed
in the field will be passed to the browser when up. That
callback should be:
(abUpdateSelectFile)
3. When your form completes (i.e. on the form callback), you should
end the sync with the form by invoking:
(abEndSyncWithSelectFile)
Ideally this should be done on both the OK and Cancel callbacks
for the form. This ensures that the select file form is withdrawn
when the form is ended.
***************************************************
SCCS Info: @[EMAIL PROTECTED]
(#) abSelectFile.il 08/07/01.15:31:08 1.3
*/
/* initialisation - make sure they're bound */
(setq abSelectFileSyncForm nil)
(setq abSelectFileSyncField nil)
(setq abSelectFileDirOnly nil)
(setq abSelectFileShowHidden nil)
/*******************************************************************
* *
* (abSimplifyFilename fileName) *
* *
* Get round the inconsistency of simplifyFilename which means that *
* it sometimes ends in /, and sometimes doesn't *
* *
*******************************************************************/
(procedure (abSimplifyFilename fileName)
(let (newFileName)
(unless (equal (substring (setq newFileName (simplifyFilename
fileName)) -1) "/")
(setq newFileName (strcat newFileName "/")))
newFileName))
/*************************************************************************
* *
* (abGetDirAssoc @[EMAIL PROTECTED]
(dirName ".") (dirOnly nil) (showHidden nil)) *
* *
* Generate an assoc list of directory entries. The assoc list contains *
* the normal "ls -F" style suffixes on each name. Note that this doesn't *
* check that the directory exists - that is the job of the calling *
* function. Setting dirOnly to t filters out everything that isn't *
* a directory. Setting showHidden to t stops dot files being filtered. *
* *
*************************************************************************/
(procedure (abGetDirAssoc @[EMAIL PROTECTED]
(dirName ".") (dirOnly nil) (showHidden
nil))
(let (dirList dirAssoc entryPlusType fullEntry simplifiedDir newDir
simplifiedNewDir simplifiedDotDotDir)
(setq dirList (reverse (sort (getDirFiles dirName) 'alphalessp)))
/* used for checking links */
(setq simplifiedDir (abSimplifyFilename dirName))
(foreach entry dirList
(setq fullEntry (strcat simplifiedDir entry))
/* if dirOnly t, only include directories */
(when (and (or (null dirOnly) (isDir fullEntry)) (nequal entry "."))
/* process up directory differently */
(if (equal entry "..")
(progn
(setq newDir (car (abDirAndFile dirName)))
(setq simplifiedNewDir (abSimplifyFilename newDir))
(setq simplifiedDotDotDir (abSimplifyFilename (strcat dirName
"/..")))
(if (equal simplifiedNewDir simplifiedDotDotDir)
(setq dirAssoc (cons (list ".. (Go up 1 directory level)"
newDir) dirAssoc))
(progn
(setq dirAssoc (cons (list ".. (Go up 1 directory level)"
simplifiedDotDotDir) dirAssoc))
(setq dirAssoc (cons (list ".. (Go up 1 directory level via link)"
newDir) dirAssoc))
)))
(when (or showHidden (nequal (getchar entry 1) '\.))
/* append file type characters on end of string in file list */
(setq entryPlusType
(strcat entry
(cond
((isDir fullEntry) "/")
((i***ecutable fullEntry) "*")
((nequal fullEntry (simplifyFilename fullEntry)) "@[EMAIL PROTECTED]
")
(t ""))))
/* only stick a / in the middle if it doesn't already end in a / */
(if (equal (substring dirName -1) "/")
(setq dirAssoc (cons (list entryPlusType (strcat dirName entry))
dirAssoc))
(setq dirAssoc (cons (list entryPlusType (strcat dirName "/"
entry)) dirAssoc))))
)))
dirAssoc))
/***************************************************************
* *
* (abDirAndFile fileName) *
* *
* Tries to split a fileName up into directory *
* and file parts *
* *
***************************************************************/
(procedure (abDirAndFile fileName)
(let (compList dir file dirAndFile)
(setq compList (parseString fileName "/"))
/* fiddle for filenames beginning with / */
(when (equal (substring fileName 1 1) "/")
(setq compList (cons "" compList)))
(if (onep (length compList))
/* if it's a directory without any slashes in */
(if (isDir fileName)
(if (equal fileName "/")
(progn
(setq dir "/")
(setq file nil))
(progn
/* if it can't be reduced, try to use simplifyFileName */
(setq dirAndFile (abDirAndFile (simplifyFilename fileName)))
(setq dir (car dirAndFile))
(setq file (cadr dirAndFile))))
(progn
(setq dir ".")
(setq file fileName)))
(progn
(when (equal
(setq dir (buildString (reverse (cdr (reverse compList))) "/"))
"")
(setq dir "/"))
(setq file (car (reverse compList)))))
(list dir file)))
/***************************************************************
* *
* (abCreateSelectFileForm) *
* *
* Create the form used to display the list in *
* Better than using a list box, because it is easier *
* to update (simply change the choices field of the *
* list box). *
* *
***************************************************************/
(procedure (abCreateSelectFileForm)
(let (fileList)
(setq fileList
(hiCreateListBoxField
?name 'fileList
?choices '("")
?doubleClickCB "(abSelectFileDC)"
))
(setq abSelectFileForm
(hiCreateAppForm
?name 'abSelectFileForm
?fields (list
(list fileList 0:0 300:350))
?formTitle "."
?buttonLayout '(OKCancel (Hidden\ Files abToggleHiddenFiles))
?callback '(abSelectFileCB abSelectFileCancel)))))
/***************************************************************
* *
* (abCreateSelectFileList @[EMAIL PROTECTED]
(fileName ".") (dirOnly nil) *
* (showHidden nil)) *
* *
* Create the select file list, and set the form contents *
* appropriately. Make sure the form is displayed. *
* *
***************************************************************/
(procedure (abCreateSelectFileList @[EMAIL PROTECTED]
(fileName ".") (dirOnly nil)
(showHidden nil))
(let (dirAssoc dirAndFile dir file value)
(if (isDir fileName)
(progn
(setq dir fileName)
(setq file nil))
(progn
(setq dirAndFile (abDirAndFile fileName))
(setq dir (car dirAndFile))
(setq file (cadr dirAndFile))))
(if (isDir dir)
(progn
(setq dirAssoc (abGetDirAssoc ?dirName dir ?dirOnly dirOnly
?showHidden showHidden))
(if file
(setq value (cdr (assoc (strcat dir "/" file) (mapcar 'reverse
dirAssoc))))
(setq value nil))
(unless (boundp 'abSelectFileForm)
(abCreateSelectFileForm))
(putpropq (getq abSelectFileForm fileList) (mapcar 'car dirAssoc)
choices)
(putpropq (getq abSelectFileForm fileList) value value)
(putpropq (getq abSelectFileForm fileList) dirAssoc dirAssoc)
(hiChangeFormTitle abSelectFileForm dir)
(hiDisplayForm abSelectFileForm)
t)
(progn
(hiDisplayAppDBox
?name 'abSFinvalidDirectory
?dboxBanner "Invalid Directory"
?dboxText "Specified Directory is Invalid"
?dialogType hicErrorDialog
?buttonLayout 'Close)
nil
)
)
))
/***************************************************************
* *
* (abSyncWithSelectFile form field @[EMAIL PROTECTED]
(dirOnly nil)) *
* *
* Synchronise the user form with the select file form. *
* *
***************************************************************/
(procedure (abSyncWithSelectFile form field @[EMAIL PROTECTED]
(dirOnly nil)
(showHidden nil))
(setq abSelectFileSyncForm form)
(setq abSelectFileSyncField field)
(setq abSelectFileNewFileName nil)
(setq abSelectFileDirOnly dirOnly)
(setq abSelectFileShowHidden showHidden)
(abUpdateSelectFile))
/***************************************************************
* *
* (abEndSyncWithSelectFile) *
* *
* End the synchronisation with the form. *
* *
***************************************************************/
(procedure (abEndSyncWithSelectFile)
(when (and
(boundp 'abSelectFileForm)
(hiIsForm abSelectFileForm)
(hiIsFormDisplayed abSelectFileForm)
)
(hiFormCancel abSelectFileForm)
)
(setq abSelectFileSyncForm nil)
(setq abSelectFileSyncField nil)
)
/***************************************************************
* *
* (abUpdateSelectFile) *
* *
* callback procedure for the field which is synchronised to *
* the select file form. *
* *
***************************************************************/
(procedure (abUpdateSelectFile)
(let (fileName)
(when abSelectFileSyncForm
(setq fileName (getq (get abSelectFileSyncForm
abSelectFileSyncField) value))
(if (equal fileName "")
(progn
(setq fileName ".")
(putpropq (get abSelectFileSyncForm abSelectFileSyncField) fileName
value))
(abCreateSelectFileList ?fileName fileName ?dirOnly abSelectFileDirOnly
?showHidden abSelectFileShowHidden)))))
/***************************************************************
* *
* (abToggleHiddenFiles form) *
* *
* Callback for "Hidden Files" button which toggles whether *
* hidden (i.e. dot) files are displayed or not. *
* *
***************************************************************/
(procedure (abToggleHiddenFiles form)
(setq abSelectFileShowHidden (null abSelectFileShowHidden))
(abUpdateSelectFile))
/***************************************************************
* *
* (abSelectFileCB form) *
* *
* Callback used when OK or apply is hit *
* *
***************************************************************/
(procedure (abSelectFileCB form)
(let (fileName syncForm)
(setq fileName (cadr (assoc
(car (getq (getq abSelectFileForm fileList) value))
(getq (getq abSelectFileForm fileList) dirAssoc))))
(setq syncForm abSelectFileSyncForm)
(setq abSelectFileSyncForm nil)
(when fileName
(putpropq (get syncForm abSelectFileSyncField) fileName value))
))
/***************************************************************
* *
* (abSelectFileCancel form) *
* *
* Callback for cancelling select file form. Used to disconnect *
* select file from original form. *
* *
***************************************************************/
(procedure (abSelectFileCancel form)
(setq abSelectFileSyncForm nil))
/***************************************************************
* *
* (abSelectFileDC) *
* *
* Callback used when file is double clicked *
* *
***************************************************************/
(procedure (abSelectFileDC)
(let (fileName)
(setq fileName (cadr (assoc
(car (getq (getq abSelectFileForm fileList) value))
(getq (getq abSelectFileForm fileList) dirAssoc))))
(if (isDir fileName)
(putpropq (get abSelectFileSyncForm abSelectFileSyncField) fileName
value)
(hiFormDone abSelectFileForm))
))
|
