From: keiichi Date: Mon, 4 Oct 1999 09:57:15 +0000 (+0000) Subject: (exec-installed-p): Use `file-executable-p' instead of `file-exists-p'. X-Git-Tag: of-tm-8_7~6 X-Git-Url: http://git.chise.org/cgi-bin/gitweb.cgi?a=commitdiff_plain;h=7ef7670b2e760f58d355034bca4ae1e267052f69;p=elisp%2Fapel.git (exec-installed-p): Use `file-executable-p' instead of `file-exists-p'. When FILE already inculdes suffix in `exec-suffix-list', do not expand file name with `exec-suffix-list'. (module-installed-p): Do not use `exec-installed-p'. --- diff --git a/path-util.el b/path-util.el index 15f33b7..e6aec37 100644 --- a/path-util.el +++ b/path-util.el @@ -139,28 +139,59 @@ 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