/[graphic-forms]/trunk/src/uitoolkit/system/system-conditions.lisp
ViewVC logotype

Contents of /trunk/src/uitoolkit/system/system-conditions.lisp

Parent Directory Parent Directory | Revision Log Revision Log


Revision 481 - (show annotations)
Sun Sep 9 19:38:06 2007 UTC (6 years, 7 months ago) by junrue
File size: 3163 byte(s)
change derivation of toolkit-error and toolkit-warning to simple-error, so that we can take advantage of :format-control and :format-control, but continue to support detail slot
1 ;;;;
2 ;;;; system-conditions.lisp
3 ;;;;
4 ;;;; Copyright (C) 2006-2007, Jack D. Unrue
5 ;;;; All rights reserved.
6 ;;;;
7 ;;;; Redistribution and use in source and binary forms, with or without
8 ;;;; modification, are permitted provided that the following conditions
9 ;;;; are met:
10 ;;;;
11 ;;;; 1. Redistributions of source code must retain the above copyright
12 ;;;; notice, this list of conditions and the following disclaimer.
13 ;;;;
14 ;;;; 2. Redistributions in binary form must reproduce the above copyright
15 ;;;; notice, this list of conditions and the following disclaimer in the
16 ;;;; documentation and/or other materials provided with the distribution.
17 ;;;;
18 ;;;; 3. Neither the names of the authors nor the names of its contributors
19 ;;;; may be used to endorse or promote products derived from this software
20 ;;;; without specific prior written permission.
21 ;;;;
22 ;;;; THIS SOFTWARE IS PROVIDED BY THE AUTHORS AND CONTRIBUTORS "AS IS" AND ANY
23 ;;;; EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED
24 ;;;; WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DIS-
25 ;;;; CLAIMED. IN NO EVENT SHALL THE AUTHORS AND CONTRIBUTORS BE LIABLE FOR ANY
26 ;;;; DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES
27 ;;;; (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES;
28 ;;;; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND
29 ;;;; ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT
30 ;;;; (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS
31 ;;;; SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
32 ;;;;
33
34 (in-package :graphic-forms.uitoolkit.system)
35
36 (define-condition toolkit-error (simple-error)
37 ((detail :reader detail :initarg :detail :initform nil)))
38
39 (defmethod print-object ((obj toolkit-error) stream)
40 (let ((detail (detail obj)))
41 (cond
42 (detail
43 (format stream "~a" detail))
44 (t
45 (call-next-method)))))
46
47 (define-condition toolkit-warning (simple-warning)
48 ((detail :reader detail :initarg :detail :initform nil)))
49
50 (defmethod print-object ((obj toolkit-warning) stream)
51 (let ((detail (detail obj)))
52 (cond
53 (detail
54 (format stream "~a" detail))
55 (t
56 (call-next-method)))))
57
58 (define-condition disposed-error (error) ())
59
60 (define-condition win32-error (toolkit-error)
61 ((code :reader code :initarg :code :initform (get-last-error))))
62
63 (defmethod print-object ((obj win32-error) stream)
64 (format stream "code ~a: ~a" (code obj) (detail obj)))
65
66 (define-condition win32-warning (toolkit-warning)
67 ((code :reader code :initarg :code :initform (get-last-error))))
68
69 (defmethod print-object ((obj win32-warning) stream)
70 (format stream "code ~a: ~a" (code obj) (detail obj)))
71
72 (define-condition comdlg-error (win32-error)
73 ((dlg-code :reader dlg-code :initarg :dlg-code :initform (comm-dlg-extended-error))))
74
75 (defmethod print-object ((obj comdlg-error) stream)
76 (format stream "common dialog code ~a: ~a" (code obj) (detail obj)))

  ViewVC Help
Powered by ViewVC 1.1.5