X-Git-Url: http://git.chise.org/gitweb/?p=elisp%2Fapel.git;a=blobdiff_plain;f=path-util.el;h=2d004db2ebd0e3322c7e30d0920866252bd0421b;hp=276d35f668308da00bee871612b737b3f9fd777b;hb=8b0dbe5092ae30b5092d7abf96649f96635d1060;hpb=4e71c6cff724c86d2f564e943306d1f3f0d0d4ae diff --git a/path-util.el b/path-util.el index 276d35f..2d004db 100644 --- a/path-util.el +++ b/path-util.el @@ -19,11 +19,13 @@ ;; You should have received a copy of the GNU General Public License ;; along with GNU Emacs; see the file COPYING. If not, write to the -;; Free Software Foundation, Inc., 59 Temple Place - Suite 330, -;; Boston, MA 02111-1307, USA. +;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, +;; Boston, MA 02110-1301, USA. ;;; Code: +(require 'poe) + (defvar default-load-path load-path "*Base of `load-path'. It is used as default value of target path to search file or @@ -36,7 +38,7 @@ directories and it does not exist in `load-path'. You can use following PATH styles: load-path relative: \"PATH/\" - (it is searched from `defaul-load-path') + (it is searched from `default-load-path') home directory relative: \"~/PATH/\" \"~USER/PATH/\" absolute path: \"/HOO/BAR/BAZ/\" @@ -52,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) @@ -137,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