(in-package "USER")

;; This file defines a set of symbols that shall be the same
;; across Lucid, Lispworks, Allegro, etc. and in their
;; various incarnations.

;; First, sort out the features:

#+(and MCL CLIM-1) (pushnew :CLIM-1 *features*)
#+(and Lucid CLIM-1-0) (pushnew :CLIM-1 *features*)
#+(and Lucid CLIM-2-beta) (pushnew :CLIM-2 *features*)
#+(and Lucid CLIM-2) (pushnew :CLIM-2 *features*)
#+(and Allegro CLIM-1.1) (pushnew :CLIM-1 *features*)
#+(and Allegro CLIM-2) (pushnew :CLIM-2 *features*)
#+(and ACLPC CLIM-2)(pushnew :CLIM-2 *features*)
#+(and Symbolics CLIM-1) (pushnew :CLIM-1 *features*)
#+(and Symbolics CLIM-2) (pushnew :CLIM-2 *features*)
#+(and Lispworks CLIM-1) (pushnew :CLIM-1 *features*)
#+(and Lispworks CLIM-2) (pushnew :CLIM-2 *features*)


(defpackage "CPC"
  (:use "LISP"))

(defvar *symbols-to-import-from-packages*)

(setq *symbols-to-import-from-packages*
  '(#+CLIM-2 ("CLIM-SYS" "current-process"
	      "all-processes"
	      "make-process"
	      "processp"
	      "destroy-process"
	      "enable-process" 
	      "disable-process"
	      "process-state")
    #+allegro("SYS" ("getenv" "environment-variable"))
    #+allegro("EXCL" "shell")))

(defun symbol-in-package (symbol-name package-name)
  "assumes both arguments to be strings and combines them to be a *symbol* named PACKAGE:SYMBOL"
  (intern (string-upcase symbol-name) (string-upcase package-name)))
      
(loop for symbol-import-description in *symbols-to-import-from-packages*
    do (let ((source-package (first symbol-import-description))
	     (symbols (rest symbol-import-description)))
	 (loop for symbol in symbols
	     do (typecase symbol
		  (string (progn ;; the name of the symbol is the same in source package and cpc package
			    (import (symbol-in-package symbol source-package) "CPC")
			    (export (symbol-in-package symbol "CPC") "CPC")))
		  (list (progn ;; the name of the symbol is different in source and cpc package
			  (let ((source-symbol (symbol-in-package (first symbol) source-package))
				(target-symbol (symbol-in-package (second symbol) "CPC")))
			    ;; copy the source symbol's attributes to the target symbol
			    (when (boundp source-symbol)
			      (setf (symbol-value target-symbol) (symbol-value source-symbol)))
			    (setf (symbol-function target-symbol) (symbol-function source-symbol))
			    (export target-symbol "CPC"))))))))



