X-Git-Url: http://git.chise.org/gitweb/?a=blobdiff_plain;f=path-util.el;h=db87fc7e21e8ac839f9677bef315a043e8b5a8f1;hb=86c8b956d6f9792c9a5d5bb9c07edd4b67010468;hp=3835d02fd5e1d8142825fdb43f27839c5c02f6ba;hpb=cee4a4a3f3024b08c3c95120b2c5d690260a8f49;p=elisp%2Fapel.git diff --git a/path-util.el b/path-util.el index 3835d02..db87fc7 100644 --- a/path-util.el +++ b/path-util.el @@ -24,26 +24,7 @@ ;;; Code: -(eval-when-compile (require 'static)) - -(static-condition-case nil - (directory-files "." nil nil t) - (file-error nil);; unreadable directory. - (wrong-number-of-arguments - (or (fboundp 'si:directory-files) - (fset 'si:directory-files (symbol-function 'directory-files))) - ;; This function is also defined in poe-18, but it is needed here - ;; for compiling other packages under old Emacsen. - (defun directory-files (directory &optional full match nosort) - "Return a list of names of files in DIRECTORY. -There are three optional arguments: -If FULL is non-nil, return absolute file names. Otherwise return names - that are relative to the specified directory. -If MATCH is non-nil, mention only file names that match the regexp MATCH. -If NOSORT is dummy for compatibility. -\[poe-18.el; EMACS 19 emulating function]" - (si:directory-files directory full match)) - )) +(require 'poe) (defvar default-load-path load-path "*Base of `load-path'. @@ -73,18 +54,16 @@ You can specify following OPTIONS: (while rest (setq p (expand-file-name path (car rest))) (if (file-directory-p p) - (throw 'tag p) - ) - (setq rest (cdr rest)) - )) - (not (member p load-path)) - ) + (throw 'tag p)) + (setq rest (cdr rest)))) + (not (or (member p load-path) + (if (string-match "/$" p) + (member (substring p 0 (1- (length p))) load-path) + (member (file-name-as-directory p) load-path))))) (setq load-path (if (memq 'append options) (append load-path (list p)) - (cons p load-path) - )) - ))) + (cons p load-path)))))) ;;;###autoload (defun add-latest-path (pattern &optional all-paths) @@ -158,33 +137,65 @@ If suffixes is omitted, `exec-suffix-list' is used." (or suffixes (setq suffixes exec-suffix-list) ) - (catch 'tag - (while paths - (let ((stem (expand-file-name file (car paths))) - (sufs suffixes) + (let (files) + (catch 'tag + (while suffixes + (let ((suf (car suffixes))) + (if (and (not (string= suf "")) + (string-match (concat (regexp-quote suf) "$") file)) + (progn + (setq files (list file)) + (throw 'tag nil) + ) + (setq files (cons (concat file suf) files)) ) - (while sufs - (let ((file (concat stem (car sufs)))) - (if (file-exists-p file) + (setq suffixes (cdr suffixes)) + ))) + (setq files (nreverse files)) + (catch 'tag + (while paths + (let ((path (car paths)) + (files files) + ) + (while files + (setq file (expand-file-name (car files) path)) + (if (file-executable-p file) (throw 'tag file) - )) - (setq sufs (cdr sufs)) - )) - (setq paths (cdr paths)) - ))) + ) + (setq files (cdr files)) + ) + (setq paths (cdr paths)) + ))))) ;;;###autoload (defun module-installed-p (module &optional paths) "Return t if module is provided or exists in PATHS. If PATHS is omitted, `load-path' is used." (or (featurep module) - (exec-installed-p (symbol-name module) load-path '(".elc" ".el")) - )) + (let ((file (symbol-name module))) + (or paths + (setq paths load-path) + ) + (catch 'tag + (while paths + (let ((stem (expand-file-name file (car paths))) + (sufs '(".elc" ".el")) + ) + (while sufs + (let ((file (concat stem (car sufs)))) + (if (file-exists-p file) + (throw 'tag file) + )) + (setq sufs (cdr sufs)) + )) + (setq paths (cdr paths)) + ))))) ;;; @ end ;;; -(provide 'path-util) +(require 'product) +(product-provide (provide 'path-util) (require 'apel-ver)) ;;; path-util.el ends here