Skip to content
Snippets Groups Projects
Commit 65a14ed9 authored by Daniel Kochmański's avatar Daniel Kochmański
Browse files

clim-conditions: remove pre-ansi module

parent e367bcaa
No related branches found
No related tags found
No related merge requests found
......@@ -10,7 +10,7 @@
;; CLIM 2.0
clim-sys clim-silica clim-internals clx-clim genera-clim
;; CLIM 0.9
clim-conditions clim-shared clim-stream
clim-shared clim-stream
silica windshield on-x on-genera))
(when (find-package pkg)
(delete-package pkg)))
......
......@@ -56,11 +56,6 @@
CCL-2) ;Except for CLOSE (and WITH-OPEN-STREAM)
(pushnew :clim-uses-lisp-stream-functions *features*)
;;; CLIM-ANSI-Conditions means this lisp truly supports the ANSI CL condition system
;;; CLIM-Conditions means that it has a macro called DEFINE-CONDITION but that it works
;;; like Allegro 3.1.13 or Lucid.
(pushnew :CLIM-ANSI-Conditions *features*)
#+Allegro
(pushnew :allegro-v4.0-constructors *features*)
......
......@@ -74,11 +74,6 @@
SBCL)
(pushnew :clim-uses-lisp-stream-functions *features*)
;;; CLIM-ANSI-Conditions means this lisp truly supports the ANSI CL condition system
;;; CLIM-Conditions means that it has a macro called DEFINE-CONDITION but that it works
;;; like allegro 3.1.13 or Lucid.
(pushnew :clim-ansi-conditions *features*)
#+allegro
(pushnew :allegro-v4.0-constructors *features*)
......@@ -126,7 +121,6 @@
"reader"
"clos-patches"
"clos"
#+CLIM-conditions "condpat" ;get the define-condition macro
;; General Lisp extensions
"utilities"
......@@ -148,7 +142,7 @@
;; Basic utilities for Silica and CLIM
"clim-macros"
("transformations" #+CLIM-conditions (:load-before-compile "condpat"))
"transformations"
"regions"
"region-arithmetic"
"extended-regions"
......
;;; -*- Mode: Lisp; Syntax: ANSI-Common-Lisp; Package: CLIM-UTILS; Base: 10; Lowercase: Yes -*-
;; See the file LICENSE for the full license governing this code.
;;
(in-package :clim-utils)
;;;"Copyright (c) 1990 International Lisp Associates. All rights reserved."
;;; Lucid and Franz have an old syntax for defining conditions. We define
;;; a macro here which supports [a subset of] the ANSI syntax and which
;;; forwards to their syntax. Then we can just write DEFINE-CONDITION
;;; with [relative] impunity. I suppose there is some question about
;;; whether this macro should be in all implementations so that we can
;;; detect the non-portable cases more easily. I'll think about it.
(defmacro define-condition (name parent-types &optional slots &rest options)
(let ((readers nil)
(real-slots slots)
(trampoline-define-condition
(intern (symbol-name 'define-condition)
(find-package #+Lucid :lucid-common-lisp
#-Lucid :conditions)))
(conc-name (format nil "~A-~A-" name 'accessor-for)))
(unless parent-types
(setq parent-types '(condition)))
(unless (keywordp (first slots))
(setq real-slots nil)
(dolist (slot slots)
(let ((reader (getf (rest slot) ':reader)))
(when reader
(let ((trampoline (intern (format nil "~A~A" conc-name (first slot))
(symbol-package name))))
;; Not likely to be EQL, but can causes an infinite loop
;; in Lucid if it is...
(unless (eq trampoline reader)
(push `(eval-when (compile load eval)
(proclaim '(inline ,reader))) readers)
(push `(defun ,reader (condition)
(,trampoline condition)) readers)))))
(let ((initarg (getf (rest slot) ':initarg)))
(unless (eq initarg (intern (symbol-name (first slot)) *keyword-package*))
(error "We can't support initargs to DEFINE-CONDITION that ~
don't match the slot name.")))
(let ((initform (getf (rest slot) ':initform)))
(if initform
(push `(,(first slot) ,initform) real-slots)
(push `(,(first slot)) real-slots)))))
`(progn (,trampoline-define-condition ,name ,parent-types ,(nreverse real-slots)
(:conc-name ,conc-name)
,@options)
,@(nreverse readers))))
0% Loading or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment