;; adapath.el
;; $Id: adapath.el,v 1.6 2001/03/25 09:45:59 simon Exp $

;; Copyright (C) 1997-2001 Simon Wright <simon@pushface.org>.

;; 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 of the
;; License, 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 this program; if not, write to the Free Software
;; Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA
;; 02111-1307, USA.

;; Manipulate .adapath files, which contain colon-separated path
;; components for GNAT compilation and are used by "gnatpmake" to
;; recursively specify the overall path in a simple approach to
;; library management.

;; See http://www.pushface.org/gnatpmake/ for further
;; information.

(defcustom adapath-system-directories
  '("/usr/local/adainclude" "/usr/adainclude")
  "*List of directories to search for the Ada compiler's standard sources."
  :type '(repeat (choice :tag "Directory"
                         (const :tag "default" nil)
                         (directory :format "%v")))
  :group 'ada)

(defun adapath (&optional start)
  "Set the search path for compilation buffer error messages, and for
ff-find-other-file (C-c o), from '.adapath' files, recursively."
  (interactive "DStart directory: ")
  (let* ((thisdir (adapath--component (cond (start)
                                            (t default-directory))))
         (path (adapath--raw thisdir (list thisdir)))
	 (with-system-paths (append path adapath-system-directories))
	 (as-files (mapcar
		    (function (lambda (p) (directory-file-name p)))
		    with-system-paths))
	 (unique (adapath--remove-duplicates as-files)))
    (setq compilation-search-path unique)
    (setq ada-search-directories unique)
    (setq ff-search-directories unique)))

(defun adapath--component (dir)
  "'dir' is a directory (or file) name. Returns the name fully expanded,
as a file name (no trailing separator)."
  (directory-file-name (expand-file-name dir))
)

(defun adapath--raw (start-dir path)
  "'path' is the path so far. Look in 'start-dir' (may be a file
name) for a .adapath file; if found, add each member to the end of the
path followed by the result of a recursive call to adapath-raw from
the member directory.
Check that named directories exist, and don't enter a member more than
once."
  (save-excursion
    (let* ((thisdir (adapath--component start-dir))
           (adapath-file 
            (concat (file-name-as-directory thisdir) ".adapath")))
      (cond ((file-readable-p adapath-file)
	     (set-buffer (generate-new-buffer "Ada search path"))
	     (goto-char (point-min))
	     (insert-file-contents adapath-file nil nil nil t)
	     (goto-char (point-min))
	     (while (re-search-forward "\\([^:\n]+\\)\\(:\\|$\\)" nil t)
	       (let* ((working (file-name-as-directory thisdir))
                      (component (match-string 1))
                      ; this next might just work on VMS as well ..
                      (resultant
                       (cond ((file-name-absolute-p component) component)
                             (t (concat working component))))
                      (path-component (adapath--component resultant)))
		 (if (and (not (member path-component path))
			  (file-directory-p path-component))
		     (setq path
			   (adapath--raw
			    path-component
			    (append path (list path-component)))))))
	     (kill-buffer (current-buffer))))))
  path)

(defun adapath--append-if-exists (path name)
  "Return 'path' with 'name' appended if it exists."
  (cond ((file-directory-p name) (append path (list name)))
	(t path)))

(defun adapath--remove-duplicates (path)
  "'path' is a list (of strings). Returns 'path' with only the leading
occurrence of any item."
  (cond ((null path) '())
	(t (cons (car path) (delete (car path) (cdr path))))))

(provide 'adapath)