1 /* 2 * Condition.java 3 * 4 * Copyright (C) 2003-2007 Peter Graves 5 * $Id$ 6 * 7 * This program is free software; you can redistribute it and/or 8 * modify it under the terms of the GNU General Public License 9 * as published by the Free Software Foundation; either version 2 10 * of the License, or (at your option) any later version. 11 * 12 * This program is distributed in the hope that it will be useful, 13 * but WITHOUT ANY WARRANTY; without even the implied warranty of 14 * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 15 * GNU General Public License for more details. 16 * 17 * You should have received a copy of the GNU General Public License 18 * along with this program; if not, write to the Free Software 19 * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA. 20 * 21 * As a special exception, the copyright holders of this library give you 22 * permission to link this library with independent modules to produce an 23 * executable, regardless of the license terms of these independent 24 * modules, and to copy and distribute the resulting executable under 25 * terms of your choice, provided that you also meet, for each linked 26 * independent module, the terms and conditions of the license of that 27 * module. An independent module is a module which is not derived from 28 * or based on this library. If you modify this library, you may extend 29 * this exception to your version of the library, but you are not 30 * obligated to do so. If you do not wish to do so, delete this 31 * exception statement from your version. 32 */ 33 34 package org.armedbear.lisp; 35 36 import static org.armedbear.lisp.Lisp.*; 37 38 public class Condition extends StandardObject 39 { 40 protected String message; 41 Condition()42 public Condition() 43 { 44 super(StandardClass.CONDITION); 45 Debug.assertTrue(slots.length == 2); 46 setFormatArguments(NIL); 47 } 48 Condition(LispClass cls)49 protected Condition(LispClass cls) 50 { 51 super(cls); 52 Debug.assertTrue(slots.length >= 2); 53 setFormatArguments(NIL); 54 } 55 Condition(LispClass cls, int length)56 public Condition(LispClass cls, int length) 57 { 58 super(cls, length); 59 } 60 Condition(LispObject initArgs)61 public Condition(LispObject initArgs) 62 { 63 super(StandardClass.CONDITION); 64 Debug.assertTrue(slots.length == 2); 65 initialize(initArgs); 66 } 67 initialize(LispObject initArgs)68 protected void initialize(LispObject initArgs) 69 { 70 LispObject control = null; 71 LispObject arguments = null; 72 LispObject first, second; 73 while (initArgs instanceof Cons) 74 { 75 first = initArgs.car(); 76 initArgs = initArgs.cdr(); 77 second = initArgs.car(); 78 initArgs = initArgs.cdr(); 79 if (first == Keyword.FORMAT_CONTROL) 80 { 81 if (control == null) 82 control = second; 83 } 84 else if (first == Keyword.FORMAT_ARGUMENTS) 85 { 86 if (arguments == null) 87 arguments = second; 88 } 89 } 90 if (control != null) 91 setFormatControl(control); 92 if (arguments == null) 93 arguments = NIL; 94 setFormatArguments(arguments); 95 } 96 Condition(String message)97 public Condition(String message) 98 { 99 super(StandardClass.CONDITION); 100 Debug.assertTrue(slots.length == 2); 101 setFormatControl(message.replaceAll("~","~~")); 102 setFormatArguments(NIL); 103 } 104 getFormatControl()105 public final LispObject getFormatControl() 106 { 107 return getInstanceSlotValue(Symbol.FORMAT_CONTROL); 108 } 109 setFormatControl(LispObject formatControl)110 public final void setFormatControl(LispObject formatControl) 111 112 { 113 setInstanceSlotValue(Symbol.FORMAT_CONTROL, formatControl); 114 } 115 setFormatControl(String s)116 public final void setFormatControl(String s) 117 { 118 setFormatControl(new SimpleString(s)); 119 } 120 getFormatArguments()121 public final LispObject getFormatArguments() 122 { 123 return getInstanceSlotValue(Symbol.FORMAT_ARGUMENTS); 124 } 125 setFormatArguments(LispObject formatArguments)126 public final void setFormatArguments(LispObject formatArguments) 127 128 { 129 setInstanceSlotValue(Symbol.FORMAT_ARGUMENTS, formatArguments); 130 } 131 132 /** 133 * Extending classes should override this method if they want to 134 * customize how they will be printed. 135 */ getMessage()136 public String getMessage() 137 { 138 return null; 139 } 140 141 @Override typeOf()142 public LispObject typeOf() 143 { 144 LispObject c = getLispClass(); 145 if (c instanceof LispClass) 146 return ((LispClass)c).getName(); 147 else if (c != null) 148 return Symbol.CLASS_NAME.execute(c); 149 return Symbol.CONDITION; 150 } 151 152 @Override classOf()153 public LispObject classOf() 154 { 155 LispObject c = getLispClass(); 156 if (c != null) 157 return c; 158 return StandardClass.CONDITION; 159 } 160 161 @Override typep(LispObject type)162 public LispObject typep(LispObject type) 163 { 164 if (type == Symbol.CONDITION) 165 return T; 166 if (type == StandardClass.CONDITION) 167 return T; 168 return super.typep(type); 169 } 170 getConditionReport()171 public String getConditionReport() 172 { 173 String s = getMessage(); 174 if (s != null) 175 return s; 176 LispObject formatControl = getFormatControl(); 177 if (formatControl != NIL) 178 { 179 return format(formatControl, getFormatArguments()); 180 } 181 return unreadableString(typeOf().princToString()); 182 } 183 184 @Override printObject()185 public final String printObject() 186 { 187 final LispThread thread = LispThread.currentThread(); 188 if (Symbol.PRINT_ESCAPE.symbolValue(thread) == NIL) 189 { 190 String s = getMessage(); 191 if (s != null) 192 return s; 193 LispObject formatControl = getFormatControl(); 194 if (formatControl instanceof Function) 195 { 196 StringOutputStream stream = new StringOutputStream(); 197 Symbol.APPLY.execute(formatControl, stream, getFormatArguments()); 198 return stream.getString().getStringValue(); 199 } 200 if (formatControl instanceof AbstractString) 201 { 202 LispObject f = Symbol.FORMAT.getSymbolFunction(); 203 if (f == null || f instanceof Autoload) 204 return format(formatControl, getFormatArguments()); 205 return Symbol.APPLY.execute(f, NIL, formatControl, getFormatArguments()).getStringValue(); 206 } 207 } 208 final int maxLevel; 209 LispObject printLevel = Symbol.PRINT_LEVEL.symbolValue(thread); 210 if (printLevel instanceof Fixnum) 211 maxLevel = ((Fixnum)printLevel).value; 212 else 213 maxLevel = Integer.MAX_VALUE; 214 LispObject currentPrintLevel = 215 _CURRENT_PRINT_LEVEL_.symbolValue(thread); 216 int currentLevel = ((Fixnum)currentPrintLevel).value; 217 if (currentLevel >= maxLevel) 218 return "#"; 219 return unreadableString(typeOf().princToString()); 220 } 221 } 222