Last edit
Summary: CategoryExtensions
Added:
> CategoryExtensions
Here is a nifty trick to add subdirectories to a list:
(defun my-add-subdirs-to-list (my-directory my-list)
"Adds all immediate subdirectories of `my-directory' to `my-list'.
More precisely, this uses only the subdirectories whose names start
with letters or digits; it excludes any subdirectory named `RCS' or
`CVS', and any subdirectory that contains a file named `.nosearch'."
;; This is a derivation of normal-top-level-add-subdirs-to-load-path
;; and there is still some crud left from it.
(let (dirs
attrs
(pending (list my-directory))
subdirs-inode-list)
(let* ((this-dir (car pending))
(contents (directory-files this-dir))
(default-directory this-dir)
(canonicalized (and (eq system-type 'windows-nt)
(untranslated-canonical-name this-dir))))
;; The Windows version doesn't report meaningful inode
;; numbers, so use the canonicalized absolute file name of the
;; directory instead.
(setq attrs (or canonicalized
(nthcdr 10 (file-attributes this-dir))))
(unless (member attrs subdirs-inode-list)
(setq my-add-subdirs-inode-list
(cons attrs subdirs-inode-list))
(while contents
;; The lower-case variants of RCS and CVS are for DOS/Windows.
(unless (member (car contents) '("." ".." "RCS" "CVS" "rcs" "cvs"))
(when (and (string-match "\\`[[:alnum:]]" (car contents))
;; Avoid doing a `stat' when it isn't necessary
;; because that can cause trouble when an NFS server
;; is down.
(not (string-match "\\.elc?\\'" (car contents)))
(file-directory-p (car contents)))
(let ((expanded (expand-file-name (car contents))))
(unless (file-exists-p (expand-file-name ".nosearch"
expanded))
(setq dirs (nconc dirs (list expanded)))))))
(setq contents (cdr contents)))))
(list my-list)
(dolist (my-dir dirs)
(add-to-list my-list my-dir)))
(eval my-list))Other version
Try this other version,which may be clearer, and seems to work in XEmacs, it won’t work in GnuEmacs, since it uses a fifth optional argument to directory-files, which isn’t available in GnuEmacs.
(defun my-add-subdirs-to-list-2 (base-directory sym)
(loop for directory in (directory-files base-directory nil nil nil 'subdirectories)
unless (or (string-equal-ignore-case directory "RCS")
(string-equal-ignore-case directory "CVS")
(member* ".nosearch"
(directory-files (expand-file-name directory base-directory)
nil nil nil t)
:test 'string-equal-ignore-case))
do (add-to-list sym (expand-file-name directory base-directory))))