view lisp/apel/file-detect.el @ 155:43dd3413c7c7 r20-3b4

Import from CVS: tag r20-3b4
author cvs
date Mon, 13 Aug 2007 09:39:39 +0200
parents
children 85ec50267440
line wrap: on
line source

;;; file-detect.el --- Emacs Lisp file detection utility

;; Copyright (C) 1996,1997 Free Software Foundation, Inc.

;; Author: MORIOKA Tomohiko <morioka@jaist.ac.jp>
;; Version:
;;	$Id: file-detect.el,v 1.1 1997/06/03 04:18:35 steve Exp $
;; Keywords: install, module

;; This file is part of APEL (A Portable Emacs Library).

;; This program is free software; you can redistribute it and/or
;; modify it under the terms of the GNU General Public License as
;; published by the Free Software Foundation; either version 2, or (at
;; your option) any later version.

;; This program is distributed in the hope that it will be useful, but
;; WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
;; General Public License for more details.

;; 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.

;;; Code:

(defvar default-load-path load-path)

(defun add-path (path &rest options)
  "Add PATH to `load-path' if it exists under `default-load-path'
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')
	home directory relative: \"~/PATH/\" \"~USER/PATH/\"
	absolute path: \"/HOO/BAR/BAZ/\"

You can specify following OPTIONS:
	'all-paths	search from `load-path'
			instead of `default-load-path'
	'append		add PATH to the last of `load-path'"
  (let ((rest (if (memq 'all-paths options)
		  load-path
		default-load-path))
	p)
    (if (and (catch 'tag
	       (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))
	     )
	(setq load-path
	      (if (memq 'append options)
		  (append load-path (list p))
		(cons p load-path)
		))
      )))

(defun add-latest-path (pattern &optional all-paths)
  "Add latest path matched by PATTERN to `load-path'
if it exists under `default-load-path' directories
and it does not exist in `load-path'.

If optional argument ALL-PATHS is specified, it is searched from all
of load-path instead of default-load-path. [file-detect.el]"
  (let ((path (get-latest-path pattern all-paths)))
    (if path
	(add-to-list 'load-path path)
      )))

(defun get-latest-path (pattern &optional all-paths)
  "Return latest directory in default-load-path
which is matched to regexp PATTERN.
If optional argument ALL-PATHS is specified,
it is searched from all of load-path instead of default-load-path."
  (catch 'tag
    (let ((paths (if all-paths
		    load-path
		  default-load-path))
	  dir)
      (while (setq dir (car paths))
	(if (and (file-exists-p dir)
		 (file-directory-p dir)
		 )
	    (let ((files (sort (directory-files dir t pattern t)
			       (function file-newer-than-file-p)))
		  file)
	      (while (setq file (car files))
		(if (file-directory-p file)
		    (throw 'tag file)
		  )
		(setq files (cdr files))
		)))
	(setq paths (cdr paths))
	))))

(defun file-installed-p (file &optional paths)
  "Return absolute-path of FILE if FILE exists in PATHS.
If PATHS is omitted, `load-path' is used."
  (if (null paths)
      (setq paths load-path)
    )
  (catch 'tag
    (let (path)
      (while paths
	(setq path (expand-file-name file (car paths)))
	(if (file-exists-p path)
	    (throw 'tag path)
	  )
	(setq paths (cdr paths))
	))))

(defvar exec-suffix-list '("")
  "*List of suffixes for executable.")

(defun exec-installed-p (file &optional paths suffixes)
  "Return absolute-path of FILE if FILE exists in PATHS.
If PATHS is omitted, `exec-path' is used.
If suffixes is omitted, `exec-suffix-list' is used."
  (or paths
      (setq paths exec-path)
      )
  (or suffixes
      (setq suffixes exec-suffix-list)
      )
  (catch 'tag
    (while paths
      (let ((stem (expand-file-name file (car paths)))
	    (sufs suffixes)
	    )
	(while sufs
	  (let ((file (concat stem (car sufs))))
	    (if (file-exists-p file)
		(throw 'tag file)
	      ))
	  (setq sufs (cdr sufs))
	  ))
      (setq paths (cdr paths))
      )))

(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"))
      ))


;;; @ end
;;;

(provide 'file-detect)

;;; file-detect.el ends here