0001: /*
0002: * LispAPI.java
0003: *
0004: * Copyright (C) 2003-2004 Peter Graves
0005: * $Id: LispAPI.java,v 1.55 2004/09/23 14:34:27 piso Exp $
0006: *
0007: * This program is free software; you can redistribute it and/or
0008: * modify it under the terms of the GNU General Public License
0009: * as published by the Free Software Foundation; either version 2
0010: * of the License, or (at your option) any later version.
0011: *
0012: * This program is distributed in the hope that it will be useful,
0013: * but WITHOUT ANY WARRANTY; without even the implied warranty of
0014: * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
0015: * GNU General Public License for more details.
0016: *
0017: * You should have received a copy of the GNU General Public License
0018: * along with this program; if not, write to the Free Software
0019: * Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
0020: */
0021:
0022: package org.armedbear.j;
0023:
0024: import gnu.regexp.REException;
0025: import java.util.Iterator;
0026: import javax.swing.SwingUtilities;
0027: import javax.swing.undo.CompoundEdit;
0028: import org.armedbear.lisp.AbstractString;
0029: import org.armedbear.lisp.ConditionThrowable;
0030: import org.armedbear.lisp.Fixnum;
0031: import org.armedbear.lisp.Function;
0032: import org.armedbear.lisp.GenericFunction;
0033: import org.armedbear.lisp.JavaObject;
0034: import org.armedbear.lisp.Keyword;
0035: import org.armedbear.lisp.Lisp;
0036: import org.armedbear.lisp.LispCharacter;
0037: import org.armedbear.lisp.LispError;
0038: import org.armedbear.lisp.LispObject;
0039: import org.armedbear.lisp.LispThread;
0040: import org.armedbear.lisp.Package;
0041: import org.armedbear.lisp.Packages;
0042: import org.armedbear.lisp.Pathname;
0043: import org.armedbear.lisp.Primitive0;
0044: import org.armedbear.lisp.Primitive1;
0045: import org.armedbear.lisp.Primitive2;
0046: import org.armedbear.lisp.Primitive3;
0047: import org.armedbear.lisp.Primitive;
0048: import org.armedbear.lisp.Primitives;
0049: import org.armedbear.lisp.SimpleString;
0050: import org.armedbear.lisp.Symbol;
0051: import org.armedbear.lisp.TypeError;
0052: import org.armedbear.lisp.UndefinedFunction;
0053: import org.armedbear.lisp.WrongNumberOfArgumentsException;
0054:
0055: public final class LispAPI extends Lisp {
0056: private static final Preferences preferences = Editor.preferences();
0057:
0058: public static final Package PACKAGE_J = Packages.createPackage("J");
0059: public static final Package PACKAGE_J_INTERNALS = Packages
0060: .createPackage("J-INTERNALS");
0061: static {
0062: PACKAGE_J.usePackage(PACKAGE_CL);
0063: PACKAGE_J.usePackage(PACKAGE_EXT);
0064: PACKAGE_J.usePackage(PACKAGE_JAVA);
0065: PACKAGE_J_INTERNALS.usePackage(PACKAGE_CL);
0066: PACKAGE_J_INTERNALS.usePackage(PACKAGE_EXT);
0067: PACKAGE_J_INTERNALS.usePackage(PACKAGE_JAVA);
0068: }
0069:
0070: public static final Symbol BUFFER_STREAM = LispAPI.PACKAGE_J
0071: .addExternalSymbol("BUFFER-STREAM");
0072:
0073: public static final Symbol _CURRENT_COMMAND_ = exportSpecial(
0074: "*CURRENT-COMMAND*", PACKAGE_J, NIL);
0075:
0076: public static final Symbol _LAST_COMMAND_ = exportSpecial(
0077: "*LAST-COMMAND*", PACKAGE_J, NIL);
0078:
0079: public static final void eventHandled() {
0080: _LAST_COMMAND_.setSymbolValue(_CURRENT_COMMAND_
0081: .getSymbolValue());
0082: _CURRENT_COMMAND_.setSymbolValue(NIL);
0083: }
0084:
0085: public static final Editor checkEditor(LispObject obj)
0086: throws ConditionThrowable {
0087: if (obj == null)
0088: throw new NullPointerException();
0089: try {
0090: return (Editor) ((JavaObject) obj).getObject();
0091: } catch (ClassCastException e) {
0092: signal(new TypeError("The value " + obj.writeToString()
0093: + " is not an editor."));
0094: // Not reached.
0095: return null;
0096: }
0097: }
0098:
0099: public static final Buffer checkBuffer(LispObject obj)
0100: throws ConditionThrowable {
0101: if (obj == null)
0102: throw new NullPointerException();
0103: if (obj == NIL)
0104: return Editor.currentEditor().getBuffer();
0105: try {
0106: return (Buffer) ((JavaObject) obj).getObject();
0107: } catch (ClassCastException e) {
0108: signal(new TypeError("The value " + obj.writeToString()
0109: + " is not a buffer."));
0110: // Not reached.
0111: return null;
0112: }
0113: }
0114:
0115: private static final Position checkMark(LispObject obj)
0116: throws ConditionThrowable {
0117: if (obj == null)
0118: throw new NullPointerException();
0119: try {
0120: return (Position) ((JavaObject) obj).getObject();
0121: } catch (ClassCastException e) {
0122: signal(new TypeError("The value " + obj.writeToString()
0123: + " is not a mark."));
0124: // Not reached.
0125: return null;
0126: }
0127: }
0128:
0129: public static final Line checkLine(LispObject obj)
0130: throws ConditionThrowable {
0131: if (obj == null)
0132: throw new NullPointerException();
0133: try {
0134: return (Line) ((JavaObject) obj).getObject();
0135: } catch (ClassCastException e) {
0136: signal(new TypeError("The value " + obj.writeToString()
0137: + " is not a line."));
0138: // Not reached.
0139: return null;
0140: }
0141: }
0142:
0143: // ### current-editor
0144: private static final Primitive0 CURRENT_EDITOR = new Primitive0(
0145: "current-editor", PACKAGE_J, true, "()",
0146: "Returns the current editor as a Lisp object.") {
0147: public LispObject execute() {
0148: return new JavaObject(Editor.currentEditor());
0149: }
0150: };
0151:
0152: // ### %set-current-editor
0153: private static final Primitive1 _SET_CURRENT_EDITOR = new Primitive1(
0154: "%set-current-editor", PACKAGE_J, false, "(EDITOR)",
0155: "Makes EDITOR the current editor.") {
0156: public LispObject execute(LispObject arg)
0157: throws ConditionThrowable {
0158: Editor.setCurrentEditor(checkEditor(arg));
0159: return arg;
0160: }
0161: };
0162:
0163: // ### other-editor
0164: private static final Primitive0 OTHER_EDITOR = new Primitive0(
0165: "other-editor", PACKAGE_J, true) {
0166: public LispObject execute() {
0167: Editor otherEditor = Editor.currentEditor()
0168: .getOtherEditor();
0169: return otherEditor != null ? new JavaObject(otherEditor)
0170: : NIL;
0171: }
0172: };
0173:
0174: // ### current-buffer
0175: private static final Primitive0 CURRENT_BUFFER = new Primitive0(
0176: "current-buffer", PACKAGE_J, true) {
0177: public LispObject execute() {
0178: return new JavaObject(Editor.currentEditor().getBuffer());
0179: }
0180: };
0181:
0182: // ### editor-buffer editor => buffer
0183: private static final Primitive1 BUFFER = new Primitive1(
0184: "editor-buffer", PACKAGE_J, true) {
0185: public LispObject execute(LispObject arg)
0186: throws ConditionThrowable {
0187: return new JavaObject(checkEditor(arg).getBuffer());
0188: }
0189: };
0190:
0191: // ### buffer-name
0192: private static final Primitive BUFFER_NAME = new Primitive(
0193: "buffer-name", PACKAGE_J, true, "&optional buffer") {
0194: public LispObject execute() {
0195: String name = Editor.currentEditor().getBuffer().getTitle();
0196: return name != null ? new SimpleString(name) : NIL;
0197: }
0198:
0199: public LispObject execute(LispObject arg)
0200: throws ConditionThrowable {
0201: String name = checkBuffer(arg).getTitle();
0202: return name != null ? new SimpleString(name) : NIL;
0203: }
0204: };
0205:
0206: // ### get-buffer
0207: private static final Primitive1 GET_BUFFER = new Primitive1(
0208: "get-buffer", PACKAGE_J, true, "name") {
0209: public LispObject execute(LispObject arg)
0210: throws ConditionThrowable {
0211: if (arg instanceof AbstractString) {
0212: String name = arg.getStringValue();
0213: BufferIterator iterator = new BufferIterator();
0214: while (iterator.hasNext()) {
0215: Buffer buffer = iterator.nextBuffer();
0216: if (buffer.getTitle().equals(name))
0217: return new JavaObject(buffer);
0218: }
0219: return NIL;
0220: }
0221: if (arg instanceof JavaObject) {
0222: if (((JavaObject) arg).getObject() instanceof Buffer)
0223: return arg;
0224: }
0225: return NIL;
0226: }
0227: };
0228:
0229: // ### buffer-live-p object => generalized-boolean
0230: private static final Primitive1 BUFFER_LIVE_P = new Primitive1(
0231: "buffer-live-p", PACKAGE_J, true, "object") {
0232: public LispObject execute(LispObject arg)
0233: throws ConditionThrowable {
0234: if (arg instanceof JavaObject) {
0235: if (((JavaObject) arg).getObject() instanceof Buffer) {
0236: if (Editor.getBufferList().contains(
0237: (Buffer) ((JavaObject) arg).getObject()))
0238: return T;
0239: }
0240: }
0241: return NIL;
0242: }
0243: };
0244:
0245: // ### buffer-pathname
0246: private static final Primitive BUFFER_PATHNAME = new Primitive(
0247: "buffer-pathname", PACKAGE_J, true, "&optional buffer") {
0248: public LispObject execute() throws ConditionThrowable {
0249: File file = Editor.currentEditor().getBuffer().getFile();
0250: if (file != null && file.isLocal()) {
0251: String s = file.canonicalPath();
0252: if (file.isDirectory())
0253: if (!s.endsWith(LocalFile.getSeparator()))
0254: s = s.concat(LocalFile.getSeparator());
0255: return new Pathname(s);
0256: }
0257: return NIL;
0258: }
0259:
0260: public LispObject execute(LispObject arg)
0261: throws ConditionThrowable {
0262: File file = checkBuffer(arg).getFile();
0263: if (file != null && file.isLocal()) {
0264: String s = file.canonicalPath();
0265: if (file.isDirectory())
0266: if (!s.endsWith(LocalFile.getSeparator()))
0267: s = s.concat(LocalFile.getSeparator());
0268: return new Pathname(s);
0269: }
0270: return NIL;
0271: }
0272: };
0273:
0274: // ### buffer-string
0275: private static final Primitive BUFFER_STRING = new Primitive(
0276: "buffer-string", PACKAGE_J, true, "&optional buffer") {
0277: public LispObject execute() throws ConditionThrowable {
0278: return new SimpleString(Editor.currentBuffer().getText());
0279: }
0280:
0281: public LispObject execute(LispObject arg)
0282: throws ConditionThrowable {
0283: return new SimpleString(checkBuffer(arg).getText());
0284: }
0285: };
0286:
0287: // ### buffer-substring
0288: private static final Primitive BUFFER_SUBSTRING = new Primitive(
0289: "buffer-substring", PACKAGE_J, true,
0290: "start end &optional buffer") {
0291: public LispObject execute(LispObject first, LispObject second)
0292: throws ConditionThrowable {
0293: Region region = new Region(Editor.currentEditor()
0294: .getBuffer(), checkMark(first), checkMark(second));
0295: return new SimpleString(region.toString());
0296: }
0297:
0298: public LispObject execute(LispObject first, LispObject second,
0299: LispObject third) throws ConditionThrowable {
0300: Position start = checkMark(first);
0301: Position end = checkMark(second);
0302: Region region = new Region(checkBuffer(third), start, end);
0303: return new SimpleString(region.toString());
0304: }
0305: };
0306:
0307: // ### goto-char
0308: // goto-char position
0309: private static final Primitive GOTO_CHAR = new Primitive(
0310: "goto-char", PACKAGE_J, true) {
0311: public LispObject execute(LispObject arg)
0312: throws ConditionThrowable {
0313: // Move dot to position.
0314: final Editor editor = Editor.currentEditor();
0315: if (arg instanceof Fixnum) {
0316: Position pos = editor.getBuffer().getPosition(
0317: ((Fixnum) arg).value);
0318: if (pos != null)
0319: editor.moveDotTo(pos);
0320: } else
0321: editor.moveDotTo(checkMark(arg));
0322: return new JavaObject(editor.getDot());
0323: }
0324: };
0325:
0326: // ### move-to-position mark charpos &optional line
0327: private static final Primitive MOVE_TO_POSITION = new Primitive(
0328: "move-to-position", PACKAGE_J, true,
0329: "mark charpos &optional line") {
0330: public LispObject execute(LispObject mark, LispObject charpos)
0331: throws ConditionThrowable {
0332: Position pos = checkMark(mark);
0333: pos.setOffset(Fixnum.getValue(charpos));
0334: return mark;
0335: }
0336:
0337: public LispObject execute(LispObject mark, LispObject charpos,
0338: LispObject line) throws ConditionThrowable {
0339: Position pos = checkMark(mark);
0340: if (line == NIL)
0341: pos.setOffset(Fixnum.getValue(charpos));
0342: else
0343: pos.moveTo(checkLine(line), Fixnum.getValue(charpos));
0344: return mark;
0345: }
0346: };
0347:
0348: // ### current-point
0349: private static final Primitive0 CURRENT_POINT = new Primitive0(
0350: "current-point", PACKAGE_J, true, "") {
0351: public LispObject execute() {
0352: Position dot = Editor.currentEditor().getDot();
0353: if (dot != null)
0354: return new JavaObject(dot.copy());
0355: return NIL;
0356: }
0357: };
0358:
0359: // ### current-mark
0360: private static final Primitive0 CURRENT_MARK = new Primitive0(
0361: "current-mark", PACKAGE_J, true, "") {
0362: public LispObject execute() {
0363: Position mark = Editor.currentEditor().getMark();
0364: if (mark != null)
0365: return new JavaObject(mark.copy());
0366: return NIL;
0367: }
0368: };
0369:
0370: // ### point-min
0371: private static final Primitive0 POINT_MIN = new Primitive0(
0372: "point-min", PACKAGE_J, true) {
0373: public LispObject execute() {
0374: final Line line = Editor.currentBuffer().getFirstLine();
0375: if (line == null)
0376: return NIL;
0377: return new JavaObject(new Position(line, 0));
0378: }
0379: };
0380:
0381: // ### point-max
0382: private static final Primitive0 POINT_MAX = new Primitive0(
0383: "point-max", PACKAGE_J, true) {
0384: public LispObject execute() {
0385: Position pos = Editor.currentBuffer().getEnd();
0386: if (pos == null)
0387: return NIL;
0388: return new JavaObject(pos);
0389: }
0390: };
0391:
0392: // ### make-mark
0393: private static final Primitive1 MAKE_MARK = new Primitive1(
0394: "make-mark", PACKAGE_J, true) {
0395: public LispObject execute(LispObject first, LispObject second)
0396: throws ConditionThrowable {
0397: Line line = checkLine(first);
0398: int offset = Fixnum.getValue(second);
0399: return new JavaObject(new Position(line, offset));
0400: }
0401: };
0402:
0403: // ### mark-line
0404: private static final Primitive1 MARK_LINE = new Primitive1(
0405: "mark-line", PACKAGE_J, true) {
0406: public LispObject execute(LispObject arg)
0407: throws ConditionThrowable {
0408: return new JavaObject(checkMark(arg).getLine());
0409: }
0410: };
0411:
0412: // ### mark-charpos
0413: private static final Primitive1 MARK_CHARPOS = new Primitive1(
0414: "mark-charpos", PACKAGE_J, true) {
0415: public LispObject execute(LispObject arg)
0416: throws ConditionThrowable {
0417: return number(checkMark(arg).getOffset());
0418: }
0419: };
0420:
0421: // ### current-line
0422: private static final Primitive0 CURRENT_LINE = new Primitive0(
0423: "current-line", PACKAGE_J, true) {
0424: public LispObject execute() {
0425: Editor editor = Editor.currentEditor();
0426: Position dot = Editor.currentEditor().getDot();
0427: if (dot != null)
0428: return new JavaObject(dot.getLine());
0429: return NIL;
0430: }
0431: };
0432:
0433: // ### line-next
0434: private static final Primitive1 LINE_NEXT = new Primitive1(
0435: "line-next", PACKAGE_J, true) {
0436: public LispObject execute(LispObject arg)
0437: throws ConditionThrowable {
0438: Line next = checkLine(arg).next();
0439: return next != null ? new JavaObject(next) : NIL;
0440: }
0441: };
0442:
0443: // ### line-previous
0444: private static final Primitive1 LINE_PREVIOUS = new Primitive1(
0445: "line-previous", PACKAGE_J, true) {
0446: public LispObject execute(LispObject arg)
0447: throws ConditionThrowable {
0448: Line prev = checkLine(arg).previous();
0449: return prev != null ? new JavaObject(prev) : NIL;
0450: }
0451: };
0452:
0453: // ### line-chars
0454: private static final Primitive1 LINE_CHARS = new Primitive1(
0455: "line-chars", PACKAGE_J, true) {
0456: public LispObject execute(LispObject arg)
0457: throws ConditionThrowable {
0458: String s = checkLine(arg).getText();
0459: return s != null ? new SimpleString(s) : NIL;
0460: }
0461: };
0462:
0463: // ### line-flags
0464: private static final Primitive1 LINE_FLAGS = new Primitive1(
0465: "line-flags", PACKAGE_J, true) {
0466: public LispObject execute(LispObject arg)
0467: throws ConditionThrowable {
0468: return number(checkLine(arg).flags());
0469: }
0470: };
0471:
0472: // ### %set-line-flags
0473: private static final Primitive2 _SET_LINE_FLAGS = new Primitive2(
0474: "%set-line-flags", PACKAGE_J, false) {
0475: public LispObject execute(LispObject first, LispObject second)
0476: throws ConditionThrowable {
0477: Line line = checkLine(first);
0478: int flags = Fixnum.getValue(second);
0479: line.setFlags(flags);
0480: return second;
0481: }
0482: };
0483:
0484: // ### line-number
0485: private static final Primitive1 LINE_NUMBER = new Primitive1(
0486: "line-number", PACKAGE_J, true, "line") {
0487: public LispObject execute(LispObject arg)
0488: throws ConditionThrowable {
0489: return number(checkLine(arg).lineNumber());
0490: }
0491: };
0492:
0493: // ### char-after
0494: // Returns character immediately after mark.
0495: private static final Primitive1 CHAR_AFTER = new Primitive1(
0496: "char-after", PACKAGE_J, true) {
0497: public LispObject execute(LispObject arg)
0498: throws ConditionThrowable {
0499: return LispCharacter.getInstance(checkMark(arg).getChar());
0500: }
0501: };
0502:
0503: // ### char-before
0504: // Returns character immediately before mark.
0505: private static final Primitive1 CHAR_BEFORE = new Primitive1(
0506: "char-before", PACKAGE_J, true) {
0507: public LispObject execute(LispObject arg)
0508: throws ConditionThrowable {
0509: Position pos = checkMark(arg).copy();
0510: return pos.prev() ? LispCharacter
0511: .getInstance(pos.getChar()) : NIL;
0512: }
0513: };
0514:
0515: // ### forward-char
0516: // Move point right N characters (left if N is negative).
0517: private static final Primitive FORWARD_CHAR = new Primitive(
0518: "forward-char", PACKAGE_J, true) {
0519: public LispObject execute() throws ConditionThrowable {
0520: return forwardChar(1);
0521: }
0522:
0523: public LispObject execute(LispObject arg)
0524: throws ConditionThrowable {
0525: return forwardChar(Fixnum.getValue(arg));
0526: }
0527: };
0528:
0529: // ### backward-char
0530: // Move point left N characters (right if N is negative).
0531: private static final Primitive BACKWARD_CHAR = new Primitive(
0532: "backward-char", PACKAGE_J, true) {
0533: public LispObject execute() throws ConditionThrowable {
0534: return forwardChar(-1);
0535: }
0536:
0537: public LispObject execute(LispObject arg)
0538: throws ConditionThrowable {
0539: return forwardChar(-Fixnum.getValue(arg));
0540: }
0541: };
0542:
0543: private static final LispObject forwardChar(int n)
0544: throws ConditionThrowable {
0545: if (n != 0) {
0546: final Editor editor = Editor.currentEditor();
0547: Position pos = editor.getDot();
0548: if (pos != null) {
0549: editor.addUndo(SimpleEdit.MOVE);
0550: if (n > 0) {
0551: while (n-- > 0) {
0552: if (!pos.next())
0553: return signal(new LispError(
0554: "reached end of buffer"));
0555: }
0556: } else {
0557: Debug.assertTrue(n < 0);
0558: while (n++ < 0) {
0559: if (!pos.prev())
0560: return signal(new LispError(
0561: "reached beginning of buffer"));
0562: }
0563: }
0564: editor.moveCaretToDotCol();
0565: }
0566: }
0567: return NIL;
0568: }
0569:
0570: // ### beginning-of-line
0571: private static final Primitive BEGINNING_OF_LINE = new Primitive(
0572: "beginning-of-line", PACKAGE_J, true) {
0573: public LispObject execute() throws ConditionThrowable {
0574: Editor.currentEditor().bol();
0575: return NIL;
0576: }
0577:
0578: public LispObject execute(LispObject arg)
0579: throws ConditionThrowable {
0580: int n = (arg != NIL) ? Fixnum.getValue(arg) : 1;
0581: final Editor editor = Editor.currentEditor();
0582: Position pos = editor.getDot();
0583: if (pos != null) {
0584: editor.addUndo(SimpleEdit.MOVE);
0585: while (--n > 0) {
0586: Line nextLine = pos.getNextLine();
0587: if (nextLine != null)
0588: pos.setLine(nextLine);
0589: else
0590: break;
0591: }
0592: pos.setOffset(0);
0593: editor.moveCaretToDotCol();
0594: }
0595: return NIL;
0596: }
0597: };
0598:
0599: // ### end-of-line
0600: private static final Primitive END_OF_LINE = new Primitive(
0601: "end-of-line", PACKAGE_J, true) {
0602: public LispObject execute() throws ConditionThrowable {
0603: Editor.currentEditor().eol();
0604: return NIL;
0605: }
0606:
0607: public LispObject execute(LispObject arg)
0608: throws ConditionThrowable {
0609: int n = (arg != NIL) ? Fixnum.getValue(arg) : 1;
0610: final Editor editor = Editor.currentEditor();
0611: Position pos = editor.getDot();
0612: if (pos != null) {
0613: editor.addUndo(SimpleEdit.MOVE);
0614: while (--n > 0) {
0615: Line nextLine = pos.getNextLine();
0616: if (nextLine != null)
0617: pos.setLine(nextLine);
0618: else
0619: break;
0620: }
0621: pos.setOffset(pos.getLineLength());
0622: editor.moveCaretToDotCol();
0623: }
0624: return NIL;
0625: }
0626: };
0627:
0628: // ### backward-up-list
0629: private static final Primitive BACKWARD_UP_LIST = new Primitive(
0630: "backward-up-list", PACKAGE_J, true) {
0631: public LispObject execute() throws ConditionThrowable {
0632: LispMode.backwardUpList();
0633: return NIL;
0634: }
0635: };
0636:
0637: // ### looking-at pattern => generalized-boolean
0638: private static final Primitive LOOKING_AT = new Primitive(
0639: "looking-at", PACKAGE_J, true) {
0640: public LispObject execute(LispObject arg)
0641: throws ConditionThrowable {
0642: if (arg instanceof AbstractString) {
0643: String pattern = arg.getStringValue();
0644: Editor editor = Editor.currentEditor();
0645: Position dot = editor.getDot();
0646: if (dot != null) {
0647: if (dot.getLine().substring(dot.getOffset())
0648: .startsWith(pattern))
0649: return T;
0650: }
0651: return NIL;
0652: }
0653: return signal(new TypeError(arg, Symbol.STRING));
0654: }
0655: };
0656:
0657: private static final Symbol KEYWORD_GLOBAL = Keyword
0658: .internKeyword("GLOBAL");
0659: private static final Symbol KEYWORD_MODE = Keyword
0660: .internKeyword("MODE");
0661: private static final Symbol KEYWORD_BUFFER = Keyword
0662: .internKeyword("BUFFER");
0663: private static final Symbol KEYWORD_CURRENT = Keyword
0664: .internKeyword("CURRENT");
0665:
0666: // ### %variable-value
0667: // %variable-value symbol kind where => value
0668: private static final Primitive3 _VARIABLE_VALUE = new Primitive3(
0669: "%variable-value", PACKAGE_J, false) {
0670: public LispObject execute(LispObject first, LispObject second,
0671: LispObject third) throws ConditionThrowable {
0672: Symbol symbol = checkSymbol(first);
0673: JVar jvar = JVar.getJVar(symbol);
0674: Property property = jvar.getProperty();
0675: LispObject kind = second;
0676: LispObject where = third;
0677: final Editor editor = Editor.currentEditor();
0678: if (kind == KEYWORD_CURRENT) {
0679: if (where != NIL)
0680: return signal(new LispError("Bad argument: "
0681: + where + "."));
0682: final Buffer buffer = editor.getBuffer();
0683: if (property.isBooleanProperty())
0684: return buffer.getBooleanProperty(property) ? T
0685: : NIL;
0686: if (property.isIntegerProperty())
0687: return number(buffer.getIntegerProperty(property));
0688: String value = buffer.getStringProperty(property);
0689: return value != null ? new SimpleString(value) : NIL;
0690: }
0691: if (kind == KEYWORD_GLOBAL) {
0692: if (property.isBooleanProperty())
0693: return preferences.getBooleanProperty(property) ? T
0694: : NIL;
0695: if (property.isIntegerProperty())
0696: return number(preferences
0697: .getIntegerProperty(property));
0698: String value = preferences.getStringProperty(property);
0699: return value != null ? new SimpleString(value) : NIL;
0700: }
0701: if (kind == KEYWORD_MODE) {
0702: final Mode mode;
0703: if (where == NIL)
0704: mode = editor.getMode();
0705: else {
0706: mode = Editor.getModeList().getModeFromModeName(
0707: where.getStringValue());
0708: if (mode == null)
0709: return signal(new LispError("Unknown mode: "
0710: + where + "."));
0711: }
0712: if (property.isBooleanProperty())
0713: return mode.getBooleanProperty(property) ? T : NIL;
0714: if (property.isIntegerProperty())
0715: return number(mode.getIntegerProperty(property));
0716: String value = mode.getStringProperty(property);
0717: return value != null ? new SimpleString(value) : NIL;
0718: }
0719: if (kind == KEYWORD_BUFFER) {
0720: final Buffer buffer;
0721: if (where != NIL)
0722: buffer = checkBuffer(where);
0723: else
0724: buffer = editor.getBuffer();
0725: if (property.isBooleanProperty())
0726: return buffer.getBooleanProperty(property) ? T
0727: : NIL;
0728: if (property.isIntegerProperty())
0729: return number(buffer.getIntegerProperty(property));
0730: String value = buffer.getStringProperty(property);
0731: return value != null ? new SimpleString(value) : NIL;
0732: }
0733: return signal(new LispError("Invalid parameter: " + kind
0734: + "."));
0735: }
0736: };
0737:
0738: // ### %set-variable-value
0739: // %set-variable-value symbol kind where new-value => new-value
0740: private static final Primitive _SET_VARIABLE_VALUE = new Primitive(
0741: "%set-variable-value", PACKAGE_J, false) {
0742: public LispObject execute(LispObject[] args)
0743: throws ConditionThrowable {
0744: if (args.length != 4)
0745: return signal(new WrongNumberOfArgumentsException(this ));
0746: Symbol symbol = checkSymbol(args[0]);
0747: JVar jvar = JVar.getJVar(symbol);
0748: Property property = jvar.getProperty();
0749: LispObject kind = args[1];
0750: LispObject where = args[2];
0751: LispObject newValue = args[3];
0752: if (kind == KEYWORD_GLOBAL) {
0753: if (property.isBooleanProperty()) {
0754: if (newValue == NIL) {
0755: preferences.setProperty(property, "false");
0756: return NIL;
0757: } else {
0758: preferences.setProperty(property, "true");
0759: return T;
0760: }
0761: } else {
0762: preferences.setProperty(property, newValue
0763: .getStringValue());
0764: return newValue;
0765: }
0766: }
0767: final Editor editor = Editor.currentEditor();
0768: if (kind == KEYWORD_MODE) {
0769: final Mode mode;
0770: if (where == NIL)
0771: mode = editor.getMode();
0772: else
0773: mode = Editor.getModeList().getModeFromModeName(
0774: where.getStringValue());
0775: if (property.isBooleanProperty()) {
0776: if (newValue == NIL) {
0777: mode.setProperty(property, false);
0778: return NIL;
0779: } else {
0780: mode.setProperty(property, true);
0781: return T;
0782: }
0783: } else {
0784: mode.setProperty(property, newValue
0785: .getStringValue());
0786: return newValue;
0787: }
0788: }
0789: if (kind == KEYWORD_BUFFER) {
0790: final Buffer buffer;
0791: if (where != NIL)
0792: buffer = checkBuffer(where);
0793: else
0794: buffer = editor.getBuffer();
0795: if (property.isBooleanProperty()) {
0796: buffer.setProperty(property, newValue != NIL);
0797: return newValue != NIL ? T : NIL;
0798: }
0799: if (property.isIntegerProperty()) {
0800: buffer.setProperty(property, Fixnum
0801: .getValue(newValue));
0802: return newValue;
0803: }
0804: buffer.setProperty(property, newValue.getStringValue());
0805: return newValue;
0806: }
0807: return signal(new LispError("Invalid parameter: " + kind));
0808: }
0809: };
0810:
0811: // ### kill-theme
0812: private static final Primitive0 KILL_THEME = new Primitive0(
0813: "kill-theme", PACKAGE_J, true) {
0814: public LispObject execute() {
0815: preferences.killTheme();
0816: return T;
0817: }
0818: };
0819:
0820: // ### restore-focus
0821: private static final Primitive0 RESTORE_FOCUS = new Primitive0(
0822: "restore-focus", PACKAGE_J, true) {
0823: public LispObject execute() {
0824: Editor.currentEditor().setFocusToDisplay();
0825: return T;
0826: }
0827: };
0828:
0829: // ### global-map-key key command => generalized-boolean
0830: private static final Primitive2 GLOBAL_MAP_KEY = new Primitive2(
0831: "global-map-key", PACKAGE_J, true, "key command") {
0832: public LispObject execute(LispObject first, LispObject second)
0833: throws ConditionThrowable {
0834: String keyText = first.getStringValue();
0835: Object command;
0836: if (second instanceof AbstractString) {
0837: command = second.getStringValue();
0838: } else {
0839: // Verify that the command can be coerced to a function.
0840: coerceToFunction(second);
0841: command = second;
0842: }
0843: return KeyMap.getGlobalKeyMap().mapKey(keyText, command) ? T
0844: : NIL;
0845: }
0846: };
0847:
0848: // ### global-unmap-key key => generalized-boolean
0849: private static final Primitive1 GLOBAL_UNMAP_KEY = new Primitive1(
0850: "global-unmap-key", PACKAGE_J, true, "key") {
0851: public LispObject execute(LispObject arg)
0852: throws ConditionThrowable {
0853: String keyText = arg.getStringValue();
0854: return KeyMap.getGlobalKeyMap().unmapKey(keyText) ? T : NIL;
0855: }
0856: };
0857:
0858: // ### map-key-for-mode key command mode => generalized-boolean
0859: private static final Primitive3 MAP_KEY_FOR_MODE = new Primitive3(
0860: "map-key-for-mode", PACKAGE_J, true, "key command mode") {
0861: public LispObject execute(LispObject first, LispObject second,
0862: LispObject third) throws ConditionThrowable {
0863: String keyText = first.getStringValue();
0864: Object command;
0865: if (second instanceof AbstractString) {
0866: command = second.getStringValue();
0867: } else {
0868: // Verify that the command can be coerced to a function.
0869: coerceToFunction(second);
0870: command = second;
0871: }
0872: String modeName = third.getStringValue();
0873: Mode mode = Editor.getModeList().getModeFromModeName(
0874: modeName);
0875: if (mode == null)
0876: return signal(new LispError("Unknown mode \"".concat(
0877: modeName).concat("\"")));
0878: return mode.getKeyMap().mapKey(keyText, command) ? T : NIL;
0879: }
0880: };
0881:
0882: // ### unmap-key-for-mode key mode => generalized-boolean
0883: private static final Primitive2 UNMAP_KEY_FOR_MODE = new Primitive2(
0884: "unmap-key-for-mode", PACKAGE_J, true, "key mode") {
0885: public LispObject execute(LispObject first, LispObject second)
0886: throws ConditionThrowable {
0887: String keyText = first.getStringValue();
0888: String modeName = second.getStringValue();
0889: Mode mode = Editor.getModeList().getModeFromModeName(
0890: modeName);
0891: if (mode == null)
0892: return signal(new LispError("Unknown mode \"".concat(
0893: modeName).concat("\"")));
0894: return mode.getKeyMap().unmapKey(keyText) ? T : NIL;
0895: }
0896: };
0897:
0898: // ### %set-global-property
0899: private static final Primitive2 _SET_GLOBAL_PROPERTY = new Primitive2(
0900: "%set-global-property", PACKAGE_J, false) {
0901: public LispObject execute(LispObject first, LispObject second)
0902: throws ConditionThrowable {
0903: String key = first.getStringValue();
0904: final String value;
0905: if (second instanceof Fixnum)
0906: value = String.valueOf(Fixnum.getValue(second));
0907: else
0908: value = second.getStringValue();
0909: Editor.setGlobalProperty(key, value);
0910: return second;
0911: }
0912: };
0913:
0914: // ### insert
0915: private static final Primitive INSERT = new Primitive("insert",
0916: PACKAGE_J, true, "&rest args") {
0917: public LispObject execute(LispObject[] args)
0918: throws ConditionThrowable {
0919: if (args.length == 0)
0920: return NIL;
0921: final Editor editor = Editor.currentEditor();
0922: if (!editor.checkReadOnly())
0923: return NIL;
0924: CompoundEdit compoundEdit = editor.beginCompoundEdit();
0925: try {
0926: for (int i = 0; i < args.length; i++) {
0927: LispObject obj = args[i];
0928: if (obj instanceof LispCharacter) {
0929: editor.insertChar(((LispCharacter) obj)
0930: .getValue());
0931: } else if (obj instanceof AbstractString) {
0932: editor.insertString(obj.getStringValue());
0933: } else
0934: return signal(new TypeError(obj,
0935: "character or string"));
0936: }
0937: return NIL;
0938: } finally {
0939: editor.endCompoundEdit(compoundEdit);
0940: }
0941: }
0942: };
0943:
0944: // ### delete-region => nil
0945: private static final Primitive0 DELETE_REGION = new Primitive0(
0946: "delete-region", PACKAGE_J, true) {
0947: public LispObject execute() throws ConditionThrowable {
0948: final Editor editor = Editor.currentEditor();
0949: if (!editor.checkReadOnly())
0950: return NIL;
0951: editor.deleteRegion();
0952: return NIL;
0953: }
0954: };
0955:
0956: // ### set-mark pos => pos
0957: private static final Primitive1 SET_MARK = new Primitive1(
0958: "set-mark", PACKAGE_J, true) {
0959: public LispObject execute(LispObject arg)
0960: throws ConditionThrowable {
0961: final Editor editor = Editor.currentEditor();
0962: if (arg != NIL)
0963: editor.setMark(checkMark(arg));
0964: else
0965: editor.unmark();
0966: return arg;
0967: }
0968: };
0969:
0970: // ### undo
0971: private static final Primitive UNDO = new Primitive("undo",
0972: PACKAGE_J, true, "&optional count") {
0973: public LispObject execute() throws ConditionThrowable {
0974: Editor.currentEditor().undo();
0975: return NIL;
0976: }
0977:
0978: public LispObject execute(LispObject arg)
0979: throws ConditionThrowable {
0980: Editor editor = Editor.currentEditor();
0981: int count;
0982: if (arg == NIL)
0983: count = 1;
0984: else
0985: count = Fixnum.getValue(arg);
0986: for (int i = 0; i < count; i++)
0987: editor.undo();
0988: return NIL;
0989: }
0990: };
0991:
0992: // ### begin-compound-edit
0993: private static final Primitive0 BEGIN_COMPOUND_EDIT = new Primitive0(
0994: "begin-compound-edit", PACKAGE_J, false) {
0995: public LispObject execute() {
0996: return new JavaObject(Editor.currentEditor()
0997: .beginCompoundEdit());
0998: }
0999: };
1000:
1001: // ### end-compound-edit
1002: private static final Primitive1 END_COMPOUND_EDIT = new Primitive1(
1003: "end-compound-edit", PACKAGE_J, false) {
1004: public LispObject execute(LispObject arg)
1005: throws ConditionThrowable {
1006: try {
1007: CompoundEdit compoundEdit = (CompoundEdit) ((JavaObject) arg)
1008: .getObject();
1009: Editor.currentEditor().endCompoundEdit(compoundEdit);
1010: return NIL;
1011: } catch (ClassCastException e) {
1012: return signal(new TypeError(arg, "compound edit"));
1013: }
1014: }
1015: };
1016:
1017: // ### %log-debug
1018: private static final Primitive1 _LOG_DEBUG = new Primitive1(
1019: "%log-debug", PACKAGE_J, false) {
1020: public LispObject execute(LispObject arg)
1021: throws ConditionThrowable {
1022: Log.debug(arg.getStringValue());
1023: return arg;
1024: }
1025: };
1026:
1027: // ### get-last-event-time
1028: private static final Primitive0 GET_LAST_EVENT_INTERNAL_TIME = new Primitive0(
1029: "get-last-event-internal-time", PACKAGE_J, true) {
1030: public LispObject execute() throws ConditionThrowable {
1031: return number(Dispatcher.getLastEventMillis());
1032: }
1033: };
1034:
1035: public static void invokeOpenFileHook(Buffer buffer) {
1036: try {
1037: Primitives.FUNCALL.execute(PACKAGE_J.intern("INVOKE-HOOK"),
1038: PACKAGE_J.intern("OPEN-FILE-HOOK"), new JavaObject(
1039: buffer));
1040: } catch (Throwable t) {
1041: Log.debug(t);
1042: }
1043: }
1044:
1045: public static void invokeBufferActivatedHook(Buffer buffer) {
1046: if (buffer != null) {
1047: try {
1048: Primitives.FUNCALL.execute(PACKAGE_J
1049: .intern("INVOKE-HOOK"), PACKAGE_J
1050: .intern("BUFFER-ACTIVATED-HOOK"),
1051: new JavaObject(buffer));
1052: } catch (Throwable t) {
1053: Log.debug(t);
1054: }
1055: }
1056: }
1057:
1058: public static void invokeAfterSaveHook(Buffer buffer) {
1059: try {
1060: Primitives.FUNCALL.execute(PACKAGE_J.intern("INVOKE-HOOK"),
1061: PACKAGE_J.intern("AFTER-SAVE-HOOK"),
1062: new JavaObject(buffer));
1063: } catch (Throwable t) {
1064: Log.debug(t);
1065: }
1066: }
1067:
1068: public static void invokeLispShellStartupHook(Buffer buffer,
1069: String command) {
1070: try {
1071: Primitives.FUNCALL.execute(PACKAGE_J.intern("INVOKE-HOOK"),
1072: PACKAGE_J.intern("LISP-SHELL-STARTUP-HOOK"),
1073: new JavaObject(buffer), new SimpleString(command));
1074: } catch (Throwable t) {
1075: Log.debug(t);
1076: }
1077: }
1078:
1079: // ### invoke-later
1080: public static final Primitive1 INVOKE_LATER = new Primitive1(
1081: "invoke-later", PACKAGE_J, true) {
1082: public LispObject execute(LispObject arg)
1083: throws ConditionThrowable {
1084: final LispObject fun;
1085: if (arg instanceof Symbol)
1086: fun = arg.getSymbolFunction();
1087: else
1088: fun = arg;
1089: if (fun instanceof Function
1090: || fun instanceof GenericFunction) {
1091: Runnable r = new Runnable() {
1092: public void run() {
1093: try {
1094: funcall0(fun, LispThread.currentThread());
1095: } catch (Throwable t) {
1096: Log.error(t);
1097: }
1098: }
1099: };
1100: SwingUtilities.invokeLater(r);
1101: return NIL;
1102: }
1103: return signal(new UndefinedFunction(arg));
1104: }
1105: };
1106:
1107: // ### make-buffer-stream buffer => stream
1108: private static final Primitive MAKE_BUFFER_STREAM = new Primitive(
1109: "make-buffer-stream", PACKAGE_J, true) {
1110: public LispObject execute() throws ConditionThrowable {
1111: return new BufferStream(new Buffer(0));
1112: }
1113:
1114: public LispObject execute(LispObject arg)
1115: throws ConditionThrowable {
1116: return new BufferStream(checkBuffer(arg));
1117: }
1118: };
1119:
1120: // ### buffer-stream-buffer stream => buffer
1121: private static final Primitive1 BUFFER_STREAM_BUFFER = new Primitive1(
1122: "buffer-stream-buffer", PACKAGE_J, true) {
1123: public LispObject execute(LispObject arg)
1124: throws ConditionThrowable {
1125: if (arg instanceof BufferStream)
1126: return new JavaObject(((BufferStream) arg).getBuffer());
1127: return signal(new TypeError(arg, "BUFFER-STREAM"));
1128: }
1129: };
1130:
1131: // ### pop-to-buffer buffer => buffer
1132: private static final Primitive POP_TO_BUFFER = new Primitive(
1133: "pop-to-buffer", PACKAGE_J, true) {
1134: public LispObject execute(LispObject arg)
1135: throws ConditionThrowable {
1136: if (arg != NIL) {
1137: Buffer buffer = checkBuffer(arg);
1138: Editor editor = Editor.currentEditor();
1139: editor.makeNext(buffer);
1140: editor.activateInOtherWindow(buffer);
1141: }
1142: return arg;
1143: }
1144: };
1145:
1146: // ### switch-to-buffer buffer => buffer
1147: private static final Primitive switch_TO_BUFFER = new Primitive(
1148: "switch-to-buffer", PACKAGE_J, true) {
1149: public LispObject execute(LispObject arg)
1150: throws ConditionThrowable {
1151: Buffer buffer = checkBuffer(arg);
1152: Editor editor = Editor.currentEditor();
1153: editor.makeNext(buffer);
1154: editor.activate(buffer);
1155: return arg;
1156: }
1157: };
1158:
1159: // ### %status string => generalized-boolean
1160: private static final Primitive STATUS = new Primitive("status",
1161: PACKAGE_J, true, "string") {
1162: public LispObject execute(LispObject arg)
1163: throws ConditionThrowable {
1164: if (arg instanceof AbstractString) {
1165: final String s = ((AbstractString) arg)
1166: .getStringValue();
1167: Runnable r = new Runnable() {
1168: public void run() {
1169: try {
1170: Editor.currentEditor().status(s);
1171: } catch (Throwable t) {
1172: Log.error(t);
1173: }
1174: }
1175: };
1176: SwingUtilities.invokeLater(r);
1177: return T;
1178: }
1179: return signal(new TypeError(arg, Symbol.STRING));
1180: }
1181:
1182: public LispObject execute(LispObject first, LispObject second)
1183: throws ConditionThrowable {
1184: if (first instanceof AbstractString) {
1185: final String s = ((AbstractString) first)
1186: .getStringValue();
1187: final Editor editor = checkEditor(second);
1188: Runnable r = new Runnable() {
1189: public void run() {
1190: try {
1191: editor.status(s);
1192: } catch (Throwable t) {
1193: Log.error(t);
1194: }
1195: }
1196: };
1197: SwingUtilities.invokeLater(r);
1198: return T;
1199: }
1200: return signal(new TypeError(first, Symbol.STRING));
1201: }
1202: };
1203:
1204: // ### %search
1205: private static final Primitive _SEARCH = new Primitive("%search",
1206: PACKAGE_J, false,
1207: "pattern direction regexp-p buffer start ignore-case-p whole-words-only-p") {
1208: public LispObject execute(LispObject[] args)
1209: throws ConditionThrowable {
1210: if (args.length != 7)
1211: return signal(new WrongNumberOfArgumentsException(this ));
1212: final String pattern;
1213: if (args[0] instanceof AbstractString)
1214: pattern = args[0].getStringValue();
1215: else
1216: return signal(new TypeError(args[0], Symbol.STRING));
1217: final boolean backward;
1218: Symbol direction = checkSymbol(args[1]);
1219: if (direction == NIL
1220: || direction.getName().equals("BACKWARD"))
1221: backward = true;
1222: else if (direction.getName().equals("FORWARD"))
1223: backward = false;
1224: else
1225: return signal(new LispError("Invalid direction "
1226: + direction.writeToString()));
1227: final Buffer buffer = checkBuffer(args[3]);
1228: final Position start;
1229: if (args[4] == NIL)
1230: start = Editor.currentEditor().getDot();
1231: else
1232: start = checkMark(args[4]);
1233: final boolean ignoreCase = (args[5] != NIL);
1234: final boolean wholeWordsOnly = (args[6] != NIL);
1235: Search search = new Search(pattern, ignoreCase,
1236: wholeWordsOnly);
1237: final Position pos;
1238: if (args[2] != NIL) {
1239: try {
1240: search.setREFromPattern();
1241: } catch (REException e) {
1242: return signal(new LispError(
1243: "Invalid regular expression: \"" + pattern
1244: + '"'));
1245: }
1246: if (backward)
1247: pos = search.reverseFindRegExp(buffer, start);
1248: else
1249: pos = search.findRegExp(buffer, start);
1250: } else {
1251: if (backward)
1252: pos = search.reverseFindString(buffer, start);
1253: else
1254: pos = search.findString(buffer, start);
1255: }
1256: return pos != null ? new JavaObject(pos) : NIL;
1257: }
1258: };
1259:
1260: // ### find-file-buffer pathname => buffer
1261: private static final Primitive FIND_FILE_BUFFER = new Primitive(
1262: "find-file-buffer", PACKAGE_J, true, "pathname") {
1263: public LispObject execute(LispObject arg)
1264: throws ConditionThrowable {
1265: final Pathname pathname = Pathname.coerceToPathname(arg);
1266: final String namestring = pathname.getNamestring();
1267: if (namestring != null) {
1268: final Editor editor = Editor.currentEditor();
1269: final Buffer buffer = editor.getBuffer(File
1270: .getInstance(namestring));
1271: if (buffer != null)
1272: return new JavaObject(buffer);
1273: }
1274: return NIL;
1275: }
1276: };
1277:
1278: // ### defun-at-point => string
1279: private static final Primitive CURRENT_DEFUN = new Primitive(
1280: "defun-at-point", PACKAGE_J, true, "") {
1281: public LispObject execute() throws ConditionThrowable {
1282: String s = LispMode.getCurrentDefun(Editor.currentEditor());
1283: return s != null ? new SimpleString(s) : NIL;
1284: }
1285: };
1286:
1287: // ### forward-sexp
1288: private static final Primitive FORWARD_SEXP = new Primitive(
1289: "forward-sexp", PACKAGE_J, true, "") {
1290: public LispObject execute() throws ConditionThrowable {
1291: LispMode.forwardSexp();
1292: return NIL;
1293: }
1294: };
1295:
1296: // ### backward-sexp
1297: private static final Primitive BACKWARD_SEXP = new Primitive(
1298: "backward-sexp", PACKAGE_J, true, "") {
1299: public LispObject execute() throws ConditionThrowable {
1300: LispMode.backwardSexp();
1301: return NIL;
1302: }
1303: };
1304:
1305: static {
1306: for (Iterator it = Property.iterator(); it.hasNext();)
1307: JVar.addVariableForProperty((Property) it.next());
1308: }
1309: }
|