TheSwamp

Code Red => AutoLISP (Vanilla / Visual) => Topic started by: whdjr on June 08, 2005, 09:30:19 AM

Title: Recording Subdirectories
Post by: whdjr on June 08, 2005, 09:30:19 AM
I have this code that returns all the directories and subdirectories of the supplied path.
Code: [Select]
;;;usage (list_folders "d:\test" T)
;;;path --> is the starting path
;;;sub --> is either T or nil for recording subdirectories
(defun list_folders (path sub)
  (defun get_folders (folder / f)
    (mapcar '(lambda (x)
      (setq f (strcat folder "\\" x))
      (if sub
(cons f (apply 'append (get_folders f)))
      )
    )
   (cddr (vl-directory-files folder nil -1))
    )
  )
  (cons path (apply 'append (get_folders path)))
)

What I would like is to see if someone could help me modify it so that it will only concantenate the folder names after the original path.

Example:
This is my folder structure:
(http://www.theswamp.org/screens/whdjr/ScreenShot039.jpg)
If I set my original path as 'd:\test' I want it to return ('test a' 'test a\test a1' 'test a\test a2' 'test b' 'test b\test b1' 'test b\test b2') without the orinigal path included.

Does that make any sense?
Title: Recording Subdirectories
Post by: MP on June 08, 2005, 09:39:06 AM
First gather (in a list) all paths as fully qualified paths, e.g. ("d:\\test\\test a" "d:\\test\\test a\\ test a1" ...).

Then, using mapcar, apply a function to the list that strips of the first 'n' characters of every item, said length corresponding to the original path plus 1.

/idea
Title: Recording Subdirectories
Post by: whdjr on June 08, 2005, 09:48:38 AM
Yeah that's the easy way. :D

What I want to do is compare a list of folder structures that will have a different starting path, so I didn't want to have to add the path and then remove the path.  If that's the easiest way then I guess I could do that, I just thought the other way would be quicker. :?
Title: Recording Subdirectories
Post by: Jürg Menzi on June 08, 2005, 10:42:45 AM
Hi Will

Maybe this one can help:
Code: [Select]
;
; == Function MeGetFolders
; Scans from current folder (recursive) for folders (and files).
; Arguments [Type]:
;   Fol = Root folder [STR]
;   Pat = File name pattern
;         - Not False: eg. *.*, *.dwg [STR]
;         - False:     Folders only [BOOLEAN]
;   Rec = Recursive flag [BOOLEAN]
;         - True:  scan folders recursive
;         - False: scan first folder level
; Return [Type]:
;   > If pattern argument False:
;     '("Pth1" "Pth2"...) [LIST]
;   > If pattern argument not False:
;     '(("Pth1" '("Fil1" "Fil2"...)) ("Pth2" '(...))...) [LIST]
; Notes:
;   - If no files found in a folder, the file list returns a '("").
;   - Deep folder structure slow down the function.
;
(defun MeGetFolders (Fol Pat Rec / FolLst TmpFol)
 (setq TmpFol (if (wcmatch Fol "*\\") (substr Fol 1 (1- (strlen Fol))) Fol)
       FolLst (cons TmpFol (apply 'append (MeGetFoldersRec TmpFol Rec)))
 )
 (if Pat
  (mapcar
  '(lambda (l)
    (cons l (cond ((vl-directory-files l Pat 1)) ('(""))))
   ) FolLst
  )
  FolLst
 )
)
;
; == Function MeGetFoldersRec
; Recursive function for MeGetFolders.
; Arguments [Type]:
;   Fol = Folder [STR]
;   Rec = Recursive flag [BOOLEAN]
;         - True:  scan folders recursive
;         - False: scan first folder level
; Return [Type]:
;   > Folder list '((Pth1) (Pth2)) [LIST]
; Notes:
;   Return value contain nil atoms.
;
(defun MeGetFoldersRec (Fol Rec / TmpFol)
 (mapcar
 '(lambda (l)
   (if (not (wcmatch l "`.*"))
    (cons
     (setq TmpFol (strcat Fol "\\" l))
     (if Rec (apply 'append (MeGetFoldersRec TmpFol Rec)))
    )
   )
  ) (vl-directory-files Fol nil -1)
 )
)


Cheers
Title: Recording Subdirectories
Post by: whdjr on June 08, 2005, 01:22:20 PM
This is what I came up with following MP's advice even though I think it is too much processing.  If anyone has any more thoughts please share.  For now I will use this and continue.
Code: [Select]
(defun get_folders (path) (cddr (vl-directory-files path nil -1)))

(defun str_cat (path name) (strcat path "\\" name))

(defun get_subs (folder / f)
  (mapcar '(lambda (x)
    (setq f (str_cat folder x))
    (cons f (apply 'append (get_subs f)))
  )
 (get_folders folder)
  )
)

(setq tfolder "C:\\ADT 2005 CD Image"); <--Insert your folder name here

(mapcar '(lambda (x) (substr x (1+ (strlen tfolder))))
(apply 'append (get_subs tfolder))
)


Thanks MP.
Title: Recording Subdirectories
Post by: MP on June 08, 2005, 01:35:56 PM
My pleasure Will.

First thing I'd do once I proved an algorythm works is attempt to remove any unnecessary processing, esp. from iterative coding, for example --

Code: [Select]
(setq pointer (1+ (strlen tfolder)))

(mapcar  
   '(lambda (x) (substr x pointer))
    (apply 'append (get_subs tfolder))
)


:)

Also, consider that your core functions should perform the bulk of this work for you, that is, the mapcar bit above should be transparent to the caller.

/IMO

:)
Title: Recording Subdirectories
Post by: whdjr on June 08, 2005, 01:43:24 PM
:(

That was a last minute add after I realized 'vl-string-left-trim removed too much of the string.  I didn't test it fully before posting. :?  
I know, I know, that is a bad practice.  I won't let it happen again Mr.Puckett. :)
Title: Recording Subdirectories
Post by: MP on June 08, 2005, 01:52:57 PM
Wasn't trying to sound finger wavin' Will, just trying to help in whatever small ways I can.

:)
Title: Recording Subdirectories
Post by: whdjr on June 08, 2005, 02:02:50 PM
Yeah I know, I was just havin a little laugh. :lol:
Title: Recording Subdirectories
Post by: JohnK on June 08, 2005, 02:10:56 PM
Jürg, Hey thats perty cool! I like that.
Title: Recording Subdirectories
Post by: Jürg Menzi on June 09, 2005, 04:32:38 AM
Quote from: Se7en
Jürg, Hey thats perty cool! I like that.
Thx for the flowers :)