;;
;; $Id: project.el,v 1.7 1995/05/18 21:22:24 ejb Exp $
;; $Source: /home/ejb/elisp/q/RCS/project.el,v $
;; $Author: ejb $
;;
;;  NOTE: This file comes from ejb's home directory.  If you modify it,
;;        please say so so that his copy can be kept up-to-date.
;;
;; Author: E. Jay Berkenbilt (ejb@ERA.COM)
;;
;; This file implements support for a special minor-mode that can be
;; project-specific.
;;

(provide 'project)

(defvar project-alist nil "*List of projects for project-mode
Each element of the list is a list of the form (PATH NAME HOOKS)
where path is an expression to match paths in this mode, name
is the name of the minor mode, and hooks is the hooks to call for
that mode.")

(defun proj-command-output (cmd &rest args)
  "Run command and return its output as a string"
  (let ((buf (get-buffer-create (concat (make-temp-name "*") "*")))
	result)
    (save-excursion
      (set-buffer buf)
      (erase-buffer)
      (if (eval (append '(call-process cmd nil t nil) args))
	  (progn
	    (goto-char (point-max))
	    (delete-backward-char 1)
	    (setq result (buffer-string))
	    (kill-buffer buf)
	    result
	    )
	""
	)
      )
    )
  )

(defun proj-file-truename (name use-bcs)
  "Give true name of file.  If use-bcs, give clean path; otherwise canon path."
  (let (result)
    (setq result
	  (if use-bcs
	      (if (file-exists-p name)
		  (proj-command-output "bcs_info" "--clean-path" name)
		(concat (proj-command-output "bcs_info" "--clean-path"
					     (file-name-directory name))
			"/" (file-name-nondirectory name)))
	    ""))
    (if (or (equal result "")
	    (not (equal (substring result 0 1) "/")))
	(file-truename name)
      result)
    )
  )

(defun project-check ()
  "Check to see whether the file being loaded is part of a certain
project"
  ;; Compensate for emacs 18 not having file-truename.  This will
  ;; make this functionality not always work, but at least it will
  ;; work sometimes and not have errors.
  (if (not (fboundp 'file-truename))
      (fset 'file-truename (symbol-function 'expand-file-name)))
  (let ((alist project-alist)
	(true-name (proj-file-truename buffer-file-name nil))
	(bcs-name nil)
	project hooks)
    (while (and (not project) alist (car alist))
      (let*
	  ((elem (car alist))
	   (use-bcs (nth 3 elem))
	   name
	   )
	(if (and use-bcs (null bcs-name))
	    (setq bcs-name (proj-file-truename buffer-file-name t)))
	(setq name (if use-bcs bcs-name true-name))
	(if (string-match (proj-file-truename (car elem) use-bcs) name)
	    (progn
	      (setq project (nth 1 elem))
	      (setq hooks (nth 2 elem)))
	  (setq alist (cdr alist)))))
    (project-mode project hooks)
    )
  )

(defvar project-name nil)
(defvar project-mode nil)

(defun project-mode (project hooks)
  (if project
      (progn
	(make-variable-buffer-local 'project-name)
	(make-variable-buffer-local 'project-mode)
	(setq project-name project)
	(setq project-mode t)
	(if hooks
	    (run-hooks hooks))
	)
    )
  )

(setq minor-mode-alist
      (append '(
		(project-mode project-name)
		)
	      minor-mode-alist))

(add-hook 'find-file-hooks 'project-check)