;; Copyright (C) 1993, 1994, 1995, 1997, 1998 Free Software Foundation, Inc.
;;
;; 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 this software; see the file COPYING.  If not, write to
;; the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
;;
;; As a special exception, the Free Software Foundation gives permission
;; for additional uses of the text contained in its release of GUILE.
;;
;; The exception is that, if you link the GUILE library with other files
;; to produce an executable, this does not by itself cause the
;; resulting executable to be covered by the GNU General Public License.
;; Your use of that executable is in no way restricted on account of
;; linking the GUILE library code into it.
;;
;; This exception does not however invalidate any other reasons why
;; the executable file might be covered by the GNU General Public License.
;;
;; This exception applies only to the code released by the
;; Free Software Foundation under the name GUILE.  If you copy
;; code from other Free Software Foundation releases into a copy of
;; GUILE, as the General Public License permits, the exception does
;; not apply to the code that you add in this way.  To avoid misleading
;; anyone as to the status of such modified files, you must delete
;; this exception notice from them.
;;
;; If you write modifications of your own for GUILE, it is your choice
;; whether to permit this exception to apply to your modifications.
;; If you do not wish that, delete this exception notice.

;;;; "mkimpcat.scm" Build SCM-specific catalog for SLIB.
;;; Author: Aubrey Jaffer.

(let ((catname "implcat"))
  (call-with-output-file (in-vicinity (implementation-vicinity) catname)
    (lambda (op)
      (define (display* . args)
	(for-each (lambda (arg) (display arg op)) args)
	(newline op))
      (define wb:vicinity (string-append (implementation-vicinity) "../wb/"))
      (define x-scm:vicinity
	(string-append (implementation-vicinity) "../xscm-2.01/"))
      (define (add-link feature ofile . libs)
	(cond ((file-exists? ofile)
	       ;; remove #f from libs list
	       (set! libs (let rem ((l libs))
			    (cond ((null? l) l)
				  ((car l) (cons (car l) (rem (cdr l))))
				  (else (rem (cdr l))))))
	       (display " " op)
	       (write (cons feature (cons 'compiled (cons ofile libs))) op)
	       (newline op)
	       #t)
	      (else #f)))
      (define (add-alias from to)
	(display " " op)
	(write (cons from to) op)
	(newline op))
      (define (add-source feature filename) (add-alias feature filename))
      (define (add-links feature usr:lib x:lib link:able-suffix)
	(display* "#+" feature)
	(display* "(")
	(begin
	  (cond ((add-link 'i/o-extensions
			   (in-vicinity (implementation-vicinity) "ioext"
					link:able-suffix)
			   (usr:lib "c"))
		 (add-alias 'line-i/o 'i/o-extensions)
		 (add-alias 'pipe 'i/o-extensions)))
	  (cond ((add-link 'rev2-procedures
			   (in-vicinity (implementation-vicinity) "sc2"
					link:able-suffix))
		 (add-alias  'rev3-procedures 'rev2-procedures)))
	  (cond ((or
		  (add-link 'db
			    (in-vicinity wb:vicinity "db.so"))
		  (add-link 'db
			    (in-vicinity wb:vicinity "db" link:able-suffix)
			    (in-vicinity wb:vicinity "handle" link:able-suffix)
			    (in-vicinity wb:vicinity "blink" link:able-suffix)
			    (in-vicinity wb:vicinity "prev" link:able-suffix)
			    (in-vicinity wb:vicinity "ent" link:able-suffix)
			    (in-vicinity wb:vicinity "sys" link:able-suffix)
			    (in-vicinity wb:vicinity "del" link:able-suffix)
			    (in-vicinity wb:vicinity "stats" link:able-suffix)
			    (in-vicinity wb:vicinity "blkio" link:able-suffix)
			    (in-vicinity wb:vicinity "scan" link:able-suffix)
			    (usr:lib "c")))
		 (add-source 'wb-table
			     (in-vicinity wb:vicinity "wbtab"))
		 (add-alias 'wb 'db)))
	  (cond ((add-link 'stringvector
			   (in-vicinity x-scm:vicinity "strvec" link:able-suffix))
		 (add-source 'x11   (in-vicinity x-scm:vicinity "x11"))
		 (add-source 'xevent(in-vicinity x-scm:vicinity "xevent"))
		 (add-source 'xt    (in-vicinity x-scm:vicinity "xt"))
		 (add-source 'xm    (in-vicinity x-scm:vicinity "xm"))
		 (add-source 'xmsubs(in-vicinity x-scm:vicinity "xmsubs"))
		 (add-source 'xaw   (in-vicinity x-scm:vicinity "xaw"))
		 (add-source 'xpm   (in-vicinity x-scm:vicinity "xpm"))))

	  (add-link 'turtle-graphics
		    (in-vicinity (implementation-vicinity) "turtlegr"
				 link:able-suffix)
		    (x:lib "X11")
		    (usr:lib "m")
		    (usr:lib "c"))
	  (add-link 'curses
		    (in-vicinity (implementation-vicinity) "crs"
				 link:able-suffix)
		    (usr:lib "ncurses")
		    ;;(usr:lib "curses")
		    ;;(usr:lib "termcap")
		    (usr:lib "c"))
	  (add-link 'edit-line
		    (in-vicinity (implementation-vicinity) "edline"
				 link:able-suffix)
		    (usr:lib "edit")
		    (usr:lib "termcap")
		    (usr:lib "c"))
	  (add-link 'regex
		    (in-vicinity (implementation-vicinity) "rgx"
				 link:able-suffix)
		    (usr:lib "c"))
	  (add-link 'unix
		    (in-vicinity (implementation-vicinity) "unix"
				 link:able-suffix)
		    (in-vicinity (implementation-vicinity) "ioext"
				 link:able-suffix)
		    (usr:lib "c"))
	  (add-link 'posix
		    (in-vicinity (implementation-vicinity) "posix"
				 link:able-suffix)
		    (usr:lib "c"))
	  (add-link 'socket
		    (in-vicinity (implementation-vicinity) "socket"
				 link:able-suffix)
		    (usr:lib "c"))
	  (add-link 'record
		    (in-vicinity (implementation-vicinity) "record"
				 link:able-suffix))
	  (add-link 'generalized-c-arguments
		    (in-vicinity (implementation-vicinity) "gsubr"
				 link:able-suffix))
	  (add-link 'array-for-each
		    (in-vicinity (implementation-vicinity) "ramap"
				 link:able-suffix))
	  )
	(display* ")")
	)

      (begin
	(display* ";\"" catname "\" Implementation-specific SLIB catalog for "
		  (scheme-implementation-type) (scheme-implementation-version)
		  ".  -*-scheme-*-")
	(display* ";")
	(display* ";			DO NOT EDIT THIS FILE")
	(display* "; it is automagically generated by \"" *load-pathname* "\"")
	(newline op)
	)

      ;; Output association lists to file "implcat"

      (begin
	;; Simple associations -- OK for all modes of dynamic-linking
	(display* "(")
	(add-alias 'hobbit (in-vicinity (implementation-vicinity) "hobbit"))
	(add-alias 'scmhob (in-vicinity (implementation-vicinity) "scmhob"))
	(add-alias 'regex-case
		    (in-vicinity (implementation-vicinity) "rgxcase"))
	(add-alias 'url-filename
		    (in-vicinity (implementation-vicinity) "urlfile"))
	(add-source 'disarm (in-vicinity
			     (implementation-vicinity)
			     (string-append "disarm" (scheme-file-suffix))))
	(add-source 'build (in-vicinity
			    (implementation-vicinity)
			    (string-append "build" (scheme-file-suffix))))

	;; (add-alias 'impl:callback '(identity))

	(display* ")")
	)

      (begin
	;; Messy because this trait has no C-installed feature name
	(display* "#.(if (defined? renamed-identifier)")
	(display* "      '(")
	(display "       " op)
	(add-source 'macro (in-vicinity (implementation-vicinity) "Macro"))
	(display* "        )")
	(display* "      '())")
	)

      (add-links 'dld
		 (lambda (lib) (string-append "/usr/lib/lib" lib ".a"))
		 (lambda (lib) (string-append "/usr/X11/lib/lib" lib ".sa"))
		 ".o")
      (add-links 'dld:dyncm
		 (lambda (lib)
		   (or (and (member lib '("c" "m"))
			    (let ((sa (string-append "/usr/lib/lib" lib ".sa")))
			      (and (file-exists? sa) sa)))
		       (string-append "/usr/lib/lib" lib ".a")))
		 (lambda (lib) (string-append "/usr/X11/lib/lib" lib ".sa"))
		 ".o")
      (add-links 'shl
		 (lambda (lib)
		   (if (member lib '("c" "m"))
		       (string-append "/lib/lib" lib ".sl")
		       (string-append "/usr/lib/lib" lib ".sl")))
		 (lambda (lib)
		   (string-append "/usr/X11R5/lib/lib" lib ".sl"))
		 ".sl")
      (add-links 'sun-dl
		 ;; These libraries are (deferred) linked in conversion to ".so"
		 (lambda (lib) #f)
		 (lambda (lib) #f)
		 ".so")
      )))