1;;; path-util.el --- Emacs Lisp file detection utility  -*- lexical-binding: t -*-
2
3;; Copyright (C) 1996,1997,1999 Free Software Foundation, Inc.
4
5;; Author: MORIOKA Tomohiko <tomo@m17n.org>
6;; Keywords: file detection, install, module
7
8;; This file is part of APEL (A Portable Emacs Library).
9
10;; This program is free software; you can redistribute it and/or
11;; modify it under the terms of the GNU General Public License as
12;; published by the Free Software Foundation; either version 2, or (at
13;; your option) any later version.
14
15;; This program is distributed in the hope that it will be useful, but
16;; WITHOUT ANY WARRANTY; without even the implied warranty of
17;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
18;; General Public License for more details.
19
20;; You should have received a copy of the GNU General Public License
21;; along with GNU Emacs; see the file COPYING.  If not, write to the
22;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
23;; Boston, MA 02110-1301, USA.
24
25;;; Code:
26
27(defvar default-load-path load-path
28  "*Base of `load-path'.
29It is used as default value of target path to search file or
30subdirectory under load-path.")
31
32;;;###autoload
33(defun add-path (path &rest options)
34  "Add PATH to `load-path' if it exists under `default-load-path'
35directories and it does not exist in `load-path'.
36
37You can use following PATH styles:
38	load-path relative: \"PATH/\"
39			(it is searched from `default-load-path')
40	home directory relative: \"~/PATH/\" \"~USER/PATH/\"
41	absolute path: \"/HOO/BAR/BAZ/\"
42
43You can specify following OPTIONS:
44	'all-paths	search from `load-path'
45			instead of `default-load-path'
46	'append		add PATH to the last of `load-path'"
47  (let ((rest (if (memq 'all-paths options)
48		  load-path
49		default-load-path))
50	p)
51    (if (and (catch 'tag
52	       (while rest
53		 (setq p (expand-file-name path (car rest)))
54		 (if (file-directory-p p)
55		     (throw 'tag p))
56		 (setq rest (cdr rest))))
57	     (not (or (member p load-path)
58		      (if (string-match "/$" p)
59			  (member (substring p 0 (1- (length p))) load-path)
60			(member (file-name-as-directory p) load-path)))))
61	(setq load-path
62	      (if (memq 'append options)
63		  (append load-path (list p))
64		(cons p load-path))))))
65
66;;;###autoload
67(defun add-latest-path (pattern &optional all-paths)
68  "Add latest path matched by PATTERN to `load-path'
69if it exists under `default-load-path' directories
70and it does not exist in `load-path'.
71
72If optional argument ALL-PATHS is specified, it is searched from all
73of load-path instead of default-load-path."
74  (let ((path (get-latest-path pattern all-paths)))
75    (if path
76	(add-to-list 'load-path path)
77      )))
78
79;;;###autoload
80(defun get-latest-path (pattern &optional all-paths)
81  "Return latest directory in default-load-path
82which is matched to regexp PATTERN.
83If optional argument ALL-PATHS is specified,
84it is searched from all of load-path instead of default-load-path."
85  (catch 'tag
86    (let ((paths (if all-paths
87		    load-path
88		  default-load-path))
89	  dir)
90      (while (setq dir (car paths))
91	(if (and (file-exists-p dir)
92		 (file-directory-p dir)
93		 )
94	    (let ((files (sort (directory-files dir t pattern t)
95			       (function file-newer-than-file-p)))
96		  file)
97	      (while (setq file (car files))
98		(if (file-directory-p file)
99		    (throw 'tag file)
100		  )
101		(setq files (cdr files))
102		)))
103	(setq paths (cdr paths))
104	))))
105
106;;;###autoload
107(defun file-installed-p (file &optional paths)
108  "Return absolute-path of FILE if FILE exists in PATHS.
109If PATHS is omitted, `load-path' is used."
110  (if (null paths)
111      (setq paths load-path)
112    )
113  (catch 'tag
114    (let (path)
115      (while paths
116	(setq path (expand-file-name file (car paths)))
117	(if (file-exists-p path)
118	    (throw 'tag path)
119	  )
120	(setq paths (cdr paths))
121	))))
122
123;;;###autoload
124(defvar exec-suffix-list '("")
125  "*List of suffixes for executable.")
126
127;;;###autoload
128(defun exec-installed-p (file &optional paths suffixes)
129  "Return absolute-path of FILE if FILE exists in PATHS.
130If PATHS is omitted, `exec-path' is used.
131If suffixes is omitted, `exec-suffix-list' is used."
132  (or paths
133      (setq paths exec-path)
134      )
135  (or suffixes
136      (setq suffixes exec-suffix-list)
137      )
138  (let (files)
139    (catch 'tag
140      (while suffixes
141	(let ((suf (car suffixes)))
142	  (if (and (not (string= suf ""))
143		   (string-match (concat (regexp-quote suf) "$") file))
144	      (progn
145		(setq files (list file))
146		(throw 'tag nil)
147		)
148	    (setq files (cons (concat file suf) files))
149	    )
150	  (setq suffixes (cdr suffixes))
151	  )))
152    (setq files (nreverse files))
153    (catch 'tag
154      (while paths
155	(let ((path (car paths))
156	      (files files)
157	      )
158	  (while files
159	    (setq file (expand-file-name (car files) path))
160	    (if (file-executable-p file)
161		(throw 'tag file)
162	      )
163	    (setq files (cdr files))
164	    )
165	  (setq paths (cdr paths))
166	  )))))
167
168;;;###autoload
169(defun module-installed-p (module &optional paths)
170  "Return t if module is provided or exists in PATHS.
171If PATHS is omitted, `load-path' is used."
172  (or (featurep module)
173      (let ((file (symbol-name module)))
174	(or paths
175	    (setq paths load-path)
176	    )
177	(catch 'tag
178	  (while paths
179	    (let ((stem (expand-file-name file (car paths)))
180		  (sufs '(".elc" ".el"))
181		  )
182	      (while sufs
183		(let ((file (concat stem (car sufs))))
184		  (if (file-exists-p file)
185		      (throw 'tag file)
186		    ))
187		(setq sufs (cdr sufs))
188		))
189	    (setq paths (cdr paths))
190	    )))))
191
192
193;;; @ end
194;;;
195
196(require 'product)
197(product-provide (provide 'path-util) (require 'apel-ver))
198
199;;; path-util.el ends here
200