001: package gnu.jemacs.lang;
002:
003: import gnu.mapping.*;
004: import gnu.lists.*;
005: import gnu.expr.*;
006: import gnu.text.*;
007: import kawa.standard.Scheme;
008: import gnu.bytecode.Type;
009: import gnu.kawa.lispexpr.*;
010: import gnu.commonlisp.lang.*;
011:
012: public class ELisp extends Lisp2 {
013: static boolean charIsInt = false;
014:
015: /** Get a ELisp character object. */
016: public static Object getCharacter(int c) {
017: if (charIsInt)
018: return gnu.math.IntNum.make(c);
019: else
020: return Char.make((char) c);
021: }
022:
023: public static gnu.math.Numeric asNumber(Object arg) {
024: if (arg instanceof Char)
025: return gnu.math.IntNum.make(((Char) arg).intValue());
026: if (arg instanceof javax.swing.text.Position)
027: return gnu.math.IntNum
028: .make(1 + ((javax.swing.text.Position) arg)
029: .getOffset());
030: return (gnu.math.Numeric) arg;
031: }
032:
033: public static char asChar(Object x) {
034: if (x instanceof Char)
035: return ((Char) x).charValue();
036: int i;
037: if (x instanceof gnu.math.Numeric)
038: i = ((gnu.math.Numeric) x).intValue();
039: else if (x instanceof javax.swing.text.Position)
040: i = ((javax.swing.text.Position) x).getOffset() + 1;
041: else
042: i = -1;
043: if (i < 0 || i > 0xffff)
044: throw new gnu.jemacs.buffer.Signal("error",
045: "not a character value");
046: return (char) i;
047: }
048:
049: public String getName() {
050: return "Emacs-Lisp";
051: }
052:
053: static final ELisp instance;
054:
055: public static final Environment elispEnvironment = Environment
056: .make("elisp-environment");
057:
058: static {
059: instance = new ELisp();
060:
061: instance.define("t", TRUE);
062: instance.define("nil", FALSE);
063: CallContext ctx = CallContext.getInstance();
064: Environment saveEnv = ctx.getEnvironmentRaw();
065: try {
066: ctx.setEnvironmentRaw(elispEnvironment);
067: instance.initELisp();
068: } finally {
069: ctx.setEnvironmentRaw(saveEnv);
070: }
071: }
072:
073: ELisp() {
074: environ = elispEnvironment;
075: }
076:
077: private void initELisp() {
078: try {
079: // Force it to be loaded now, so we can over-ride let* length etc.
080: loadClass("gnu.commonlisp.lisp.PrimOps");
081: loadClass("gnu.jemacs.lang.NumberOps");
082: loadClass("gnu.jemacs.lang.MiscOps");
083:
084: defProcStFld("emacs", "gnu.jemacs.buffer.emacs");
085: } catch (java.lang.ClassNotFoundException ex) {
086: // Ignore - happens while building this directory.
087: }
088:
089: defSntxStFld("if", "gnu.jemacs.lang.MiscOps", "if");
090: defProcStFld("invoke", "gnu.kawa.reflect.Invoke", "invoke");
091:
092: defProcStFld("+", "gnu.jemacs.lang.AddOp", "$Pl");
093: defProcStFld("-", "gnu.jemacs.lang.AddOp", "$Mn");
094: defProcStFld("/", "gnu.jemacs.lang.DivideOp", "$Sl");
095: defProcStFld("=", "gnu.jemacs.lang.NumberCompare", "$Eq");
096: defProcStFld("<", "gnu.jemacs.lang.NumberCompare", "$Ls");
097: defProcStFld(">", "gnu.jemacs.lang.NumberCompare", "$Gr");
098: defProcStFld("<=", "gnu.jemacs.lang.NumberCompare", "$Ls$Eq");
099: defProcStFld(">=", "gnu.jemacs.lang.NumberCompare", "$Gr$Eq");
100:
101: defun("self-insert-command",
102: new gnu.jemacs.buffer.SelfInsertCommand());
103:
104: lambda lambda = new gnu.jemacs.lang.lambda();
105: lambda.setKeywords(getSymbol("&optional"), getSymbol("&rest"),
106: getSymbol("&key"));
107: lambda.defaultDefault = nilExpr;
108: defun("lambda", lambda);
109: defun("defun", new gnu.commonlisp.lang.defun(lambda));
110: defun("function", new gnu.commonlisp.lang.function(lambda));
111:
112: defun(gnu.kawa.lispexpr.LispLanguage.quote_sym,
113: kawa.lang.Quote.plainQuote);
114: defun("defgroup", new defgroup());
115: defun("defcustom", new defcustom());
116: defun("defvar", new gnu.commonlisp.lang.defvar(false));
117: defun("defconst", new gnu.commonlisp.lang.defvar(true));
118: defun("defsubst", new gnu.commonlisp.lang.defun(lambda));
119: defun("setq", new gnu.commonlisp.lang.setq());
120: defun("prog1", gnu.commonlisp.lang.prog1.prog1);
121: defun("prog2", gnu.commonlisp.lang.prog1.prog2);
122: defun("progn", new kawa.standard.begin());
123: defun("while", new gnu.jemacs.lang.While());
124: defun("unwind-protect", new gnu.commonlisp.lang.UnwindProtect());
125: defun("save-excursion",
126: new gnu.jemacs.lang.SaveExcursion(false));
127: defun("save-current-buffer", new gnu.jemacs.lang.SaveExcursion(
128: true));
129: defun("let", new kawa.standard.fluid_let(false, nilExpr));
130: defun("%let", kawa.standard.let.let);
131: defun("let*", new kawa.standard.fluid_let(true, nilExpr));
132: defProcStFld("concat", "kawa.lib.strings", "string$Mnappend");
133: Procedure not = new kawa.standard.not(this );
134: defun("not", not);
135: defun("null", not);
136: defun("eq", new gnu.kawa.functions.IsEq(this , "eq"));
137: defun("equal", new gnu.kawa.functions.IsEqual(this , "equal"));
138: defun("typep", new gnu.kawa.reflect.InstanceOf(this ));
139: defun("princ", displayFormat);
140: defun("prin1", writeFormat);
141: LocationEnumeration e = Scheme.builtin()
142: .enumerateAllLocations();
143: while (e.hasMoreElements()) {
144: importLocation(e.nextLocation());
145: }
146: try {
147: loadClass("gnu.jemacs.lisp.primitives");
148: loadClass("gnu.jemacs.buffer.emacs");
149: loadClass("gnu.jemacs.lisp.simple");
150: loadClass("gnu.jemacs.lisp.autoloads");
151: loadClass("gnu.jemacs.lisp.keymap");
152: loadClass("gnu.jemacs.lisp.editfns");
153: loadClass("gnu.jemacs.lisp.keydefs");
154: } catch (java.lang.ClassNotFoundException ex) {
155: // Ignore - happens while building this directory.
156: }
157: }
158:
159: public static ELisp getInstance() {
160: return instance;
161: }
162:
163: /** The compiler insert calls to this method for applications and applets. */
164: public static void registerEnvironment() {
165: Language.setDefaults(instance);
166: }
167:
168: static final AbstractFormat writeFormat = new Print(true);
169: static final AbstractFormat displayFormat = new Print(false);
170:
171: public AbstractFormat getFormat(boolean readable) {
172: return readable ? writeFormat : displayFormat;
173: }
174:
175: LangPrimType booleanType;
176:
177: public Type getTypeFor(String name) {
178: if (name == "t")
179: name = "java.lang.Object";
180: else if (name == "marker")
181: name = "gnu.jemacs.buffer.Marker";
182: else if (name == "buffer")
183: name = "gnu.jemacs.buffer.Buffer";
184: else if (name == "window")
185: name = "gnu.jemacs.buffer.Window";
186: return Scheme.string2Type(name);
187: }
188:
189: public Type getTypeFor(Class clas) {
190: if (clas.isPrimitive()) {
191: String name = clas.getName();
192: if (name.equals("boolean")) {
193: if (booleanType == null)
194: booleanType = new LangPrimType(Type.boolean_type,
195: this );
196: return booleanType;
197: }
198: return Scheme.getNamedType(name);
199: }
200: return Type.make(clas);
201: }
202:
203: public ReadTable createReadTable() {
204: ReadTable rt = super .createReadTable();
205: rt.set('[', new ReaderVector(']'));
206: rt.remove(']');
207: rt.set('?', new ELispReadTableEntry('?'));
208: return rt;
209: }
210:
211: public static void readableChar(char ch, StringBuffer buf,
212: boolean quote) {
213: if (quote && (ch == '\\' || ch == '\'' || ch == '\"')) {
214: buf.append('\\');
215: buf.append(ch);
216: } else if (ch > 127) {
217: buf.append("\\u");
218: String hex = Integer.toHexString(ch);
219: for (int i = hex.length(); i < 4; i++)
220: buf.append('0');
221: buf.append(hex);
222: } else if (ch >= ' ')
223: buf.append(ch);
224: else if (ch == '\t')
225: buf.append("\\t");
226: else if (ch == '\r')
227: buf.append("\\r");
228: else if (ch == '\n')
229: buf.append("\\n");
230: else {
231: buf.append("\\0");
232: buf.append((ch >> 3) & 7);
233: buf.append(ch & 7);
234: }
235: }
236:
237: /**
238: * Call toString, quoting characters that are not ascii graphic chars.
239: * This method will probably be moved somewhere more appropriate.
240: */
241: public static String readableString(Object obj) {
242: String str = obj.toString();
243: StringBuffer buf = new StringBuffer(200);
244: for (int i = 0; i < str.length(); i++)
245: readableChar(str.charAt(i), buf, false);
246: return buf.toString();
247: }
248:
249: public static void main(String[] args) {
250: kawa.repl.processArgs(new String[] { "--elisp" }, 0, 1);
251: if (args.length == 0)
252: args = new String[] { "-e", "(emacs)", "--" };
253: kawa.repl.main(args);
254: }
255: }
256:
257: class ELispReadTableEntry extends ReaderDispatchMisc {
258: public ELispReadTableEntry(int code) {
259: super (code);
260: }
261:
262: public Object read(Lexer in, int ch, int count)
263: throws java.io.IOException, SyntaxException {
264: LispReader reader = (LispReader) in;
265: if (code >= 0)
266: ch = code;
267: switch (ch) {
268: case '?':
269: ch = reader.read();
270: if (ch == '\\') {
271: ch = reader.read();
272: if (ch != ' ' && ch >= 0)
273: ch = reader.readEscape(ch);
274: }
275: if (ch < 0) {
276: reader.error("unexpected EOF in character literal");
277: ch = '?';
278: }
279: return ELisp.getCharacter(ch);
280: }
281: reader.error("unexpected dispatch character");
282: return null;
283: }
284: }
|