Ignore:
Timestamp:
02/04/05 04:28:47 (17 years ago)
Author:
piso
Message:

Work in progress.

Location:
trunk/j/src/org/armedbear
Files:
2 edited

Legend:

Unmodified
Added
Removed
  • trunk/j/src/org/armedbear/j/LispAPI.java

    r8198 r8461  
    22 * LispAPI.java
    33 *
    4  * Copyright (C) 2003-2004 Peter Graves
    5  * $Id: LispAPI.java,v 1.58 2004-11-28 15:44:25 piso Exp $
     4 * Copyright (C) 2003-2005 Peter Graves
     5 * $Id: LispAPI.java,v 1.59 2005-02-04 04:27:23 piso Exp $
    66 *
    77 * This program is free software; you can redistribute it and/or
     
    424424    // ### make-mark
    425425    private static final Primitive MAKE_MARK =
    426         new Primitive("make-mark", PACKAGE_J, true)
     426        new Primitive("make-mark", PACKAGE_J, true, "line offset")
    427427    {
    428428        public LispObject execute(LispObject first, LispObject second)
     
    437437    // ### mark-line
    438438    private static final Primitive MARK_LINE =
    439         new Primitive("mark-line", PACKAGE_J, true)
     439        new Primitive("mark-line", PACKAGE_J, true, "mark")
    440440    {
    441441        public LispObject execute(LispObject arg) throws ConditionThrowable
     
    447447    // ### mark-charpos
    448448    private static final Primitive MARK_CHARPOS =
    449         new Primitive("mark-charpos", PACKAGE_J, true)
     449        new Primitive("mark-charpos", PACKAGE_J, true, "mark")
    450450    {
    451451        public LispObject execute(LispObject arg) throws ConditionThrowable
     
    562562    // Move point right N characters (left if N is negative).
    563563    private static final Primitive FORWARD_CHAR =
    564         new Primitive("forward-char", PACKAGE_J, true)
    565     {
    566         public LispObject execute() throws ConditionThrowable
    567         {
    568             return forwardChar(1);
    569         }
    570         public LispObject execute(LispObject arg) throws ConditionThrowable
    571         {
    572             return forwardChar(Fixnum.getValue(arg));
     564        new Primitive("forward-char", PACKAGE_J, true, "mark &optional count")
     565    {
     566        public LispObject execute(LispObject arg) throws ConditionThrowable
     567        {
     568            Position pos = checkMark(arg);
     569            return forwardChar(pos, 1);
     570        }
     571        public LispObject execute(LispObject first, LispObject second)
     572            throws ConditionThrowable
     573        {
     574            Position pos = checkMark(first);
     575            return forwardChar(pos, Fixnum.getValue(second));
    573576        }
    574577    };
    575578
    576579    // ### backward-char
    577     // Move point left N characters (right if N is negative).
     580    // Move MARK left COUNT characters (right if COUNT is negative).
    578581    private static final Primitive BACKWARD_CHAR =
    579         new Primitive("backward-char", PACKAGE_J, true)
    580     {
    581         public LispObject execute() throws ConditionThrowable
    582         {
    583             return forwardChar(-1);
    584         }
    585         public LispObject execute(LispObject arg) throws ConditionThrowable
    586         {
    587             return forwardChar(-Fixnum.getValue(arg));
    588         }
    589     };
    590 
    591     private static final LispObject forwardChar(int n) throws ConditionThrowable
     582        new Primitive("backward-char", PACKAGE_J, true, "mark &optional count")
     583    {
     584        public LispObject execute(LispObject arg) throws ConditionThrowable
     585        {
     586            Position pos = checkMark(arg);
     587            return forwardChar(pos, -1);
     588        }
     589        public LispObject execute(LispObject first, LispObject second)
     590            throws ConditionThrowable
     591        {
     592            Position pos = checkMark(first);
     593            return forwardChar(pos, -Fixnum.getValue(second));
     594        }
     595    };
     596
     597    private static final LispObject forwardChar(Position pos, int n)
     598        throws ConditionThrowable
    592599    {
    593600        if (n != 0) {
    594             final Editor editor = Editor.currentEditor();
    595             Position pos = editor.getDot();
    596601            if (pos != null) {
    597                 editor.addUndo(SimpleEdit.MOVE);
    598602                if (n > 0) {
    599603                    while (n-- > 0) {
    600604                        if (!pos.next())
    601                             return signal(new LispError("reached end of buffer"));
     605                            return signal(new LispError("Reached end of buffer."));
    602606                    }
    603607                } else {
    604                     Debug.assertTrue(n < 0);
    605608                    while (n++ < 0) {
    606609                        if (!pos.prev())
    607                             return signal(new LispError("reached beginning of buffer"));
     610                            return signal(new LispError("Reached beginning of buffer."));
    608611                    }
    609612                }
    610                 editor.moveCaretToDotCol();
    611613            }
    612614        }
     
    674676    };
    675677
    676     // ### backward-up-list
     678    // ### backward-up-list mark
    677679    private static final Primitive BACKWARD_UP_LIST =
    678         new Primitive("backward-up-list", PACKAGE_J, true)
    679     {
    680         public LispObject execute() throws ConditionThrowable
    681         {
    682             LispMode.backwardUpList();
    683             return NIL;
    684         }
    685     };
    686 
    687     // ### looking-at pattern => generalized-boolean
     680        new Primitive("backward-up-list", PACKAGE_J, true, "mark")
     681    {
     682        public LispObject execute(LispObject arg) throws ConditionThrowable
     683        {
     684            Position pos = checkMark(arg);
     685            Position newPos = LispMode.findContainingSexp(pos);
     686            if (newPos != null)
     687                pos.moveTo(newPos);
     688            return arg;
     689        }
     690    };
     691
     692    // ### looking-at mark pattern => generalized-boolean
    688693    private static final Primitive LOOKING_AT =
    689         new Primitive("looking-at", PACKAGE_J, true)
    690     {
    691         public LispObject execute(LispObject arg) throws ConditionThrowable
    692         {
    693             if (arg instanceof AbstractString) {
    694                 String pattern = arg.getStringValue();
    695                 Editor editor = Editor.currentEditor();
    696                 Position dot = editor.getDot();
    697                 if (dot != null) {
    698                     if (dot.getLine().substring(dot.getOffset()).startsWith(pattern))
    699                         return T;
    700                 }
     694        new Primitive("looking-at", PACKAGE_J, true, "mark string")
     695    {
     696        public LispObject execute(LispObject first, LispObject second)
     697            throws ConditionThrowable
     698        {
     699            Position pos = checkMark(first);
     700            if (second instanceof AbstractString) {
     701                String pattern = second.getStringValue();
     702                if (pos.getLine().substring(pos.getOffset()).startsWith(pattern))
     703                    return T;
    701704                return NIL;
    702705            }
    703             return signal(new TypeError(arg, Symbol.STRING));
     706            return signal(new TypeError(second, Symbol.STRING));
    704707        }
    705708    };
     
    10201023                editor.unmark();
    10211024            return arg;
     1025        }
     1026    };
     1027
     1028    // ### copy-mark mark => copy
     1029    private static final Primitive COPY_MARK =
     1030        new Primitive("copy-mark", PACKAGE_J, true, "mark")
     1031    {
     1032        public LispObject execute(LispObject arg) throws ConditionThrowable
     1033        {
     1034            Position pos = checkMark(arg);
     1035            return new JavaObject(new Position(pos.getLine(), pos.getOffset()));
     1036        }
     1037    };
     1038
     1039    // ### mark= mark1 mark2 => generalized-boolean
     1040    private static final Primitive MARK_EQUAL =
     1041        new Primitive("mark=", PACKAGE_J, true, "mark1 mark2")
     1042    {
     1043        public LispObject execute(LispObject first, LispObject second)
     1044            throws ConditionThrowable
     1045        {
     1046            Position pos1 = checkMark(first);
     1047            Position pos2 = checkMark(second);
     1048            if (pos1.getLine() == pos2.getLine())
     1049                if (pos1.getOffset() == pos2.getOffset())
     1050                    return T;
     1051            return NIL;
    10221052        }
    10231053    };
  • trunk/j/src/org/armedbear/lisp/slime.lisp

    r8440 r8461  
    22;;;
    33;;; Copyright (C) 2004-2005 Peter Graves
    4 ;;; $Id: slime.lisp,v 1.27 2005-02-01 03:38:22 piso Exp $
     4;;; $Id: slime.lisp,v 1.28 2005-02-04 04:28:47 piso Exp $
    55;;;
    66;;; This program is free software; you can redistribute it and/or
     
    231231  (values))
    232232
    233 (defun symbol-name-at-point ()
    234   (let ((string (line-chars (current-line)))
    235         (point-charpos (mark-charpos (current-point)))
    236         (begin 0)
    237         end)
    238     (when (= point-charpos (length string))
    239       (decf point-charpos))
     233(defun symbol-name-at-mark (mark)
     234  (let* ((string (line-chars (mark-line mark)))
     235         (length (length string))
     236         (charpos (mark-charpos mark))
     237         (begin 0)
     238         end)
     239    (when (= charpos length)
     240      (decf charpos))
    240241    (loop
    241       (aver (< point-charpos (length string)))
    242       (cond ((not (delimiter-p (schar string point-charpos)))
     242      (aver (< charpos length))
     243      (cond ((not (delimiter-p (schar string charpos)))
    243244             (return))
    244             ((zerop point-charpos)
    245              (return-from symbol-name-at-point nil))
     245            ((zerop charpos)
     246             (return-from symbol-name-at-mark nil))
    246247            (t
    247              (decf point-charpos))))
    248     (dotimes (i point-charpos)
     248             (decf charpos))))
     249    (dotimes (i charpos)
    249250      (let ((c (schar string i)))
    250251        (when (delimiter-p c)
    251252          (setf begin (1+ i)))))
    252     (do ((i point-charpos (1+ i)))
    253         ((= i (length string)) (setf end i))
     253    (do ((i charpos (1+ i)))
     254        ((= i length) (setf end i))
    254255      (when (delimiter-p (schar string i))
    255256        (setf end i)
     
    257258    (subseq string begin end)))
    258259
    259 (defun enclosing-operator-names ()
     260(defun enclosing-operator-names (mark)
    260261  "Return the list of operator names of the forms containing point."
    261262  (let ((result ()))
    262     (save-excursion
    263       (loop
    264         (let ((point1 (current-point))
    265               (point2 (progn (backward-up-list) (current-point))))
    266           (when (and (equal (mark-line point1) (mark-line point2))
    267                      (eql (mark-charpos point1) (mark-charpos point2)))
    268             (return)))
    269         (unless (looking-at "(")
    270           (return))
    271         (when (looking-at "(")
    272           (forward-char)
    273           (let ((name (symbol-name-at-point)))
    274             (cond ((string-equal name "defun")
    275                    (return))
    276                   ((null name)
    277                    (return))
    278                   (t
    279                    (push name result))))
    280           (backward-up-list))))
     263    (loop
     264      (let* ((mark1 (copy-mark mark))
     265             (mark2 (progn (backward-up-list mark) (copy-mark mark))))
     266        (when (mark= mark1 mark2) ; Can't go back any further.
     267          (return)))
     268      (unless (looking-at mark "(")
     269        (return))
     270      (forward-char mark)
     271      (let ((name (symbol-name-at-mark mark)))
     272        (cond ((string-equal name "defun")
     273               (return))
     274              ((null name)
     275               (return))
     276              (t
     277               (push name result))))
     278      (backward-up-list mark))
    281279    (nreverse result)))
    282280
    283281(defun slime-space ()
    284282  (unwind-protect
    285    (when (and (slime-connected-p)
    286               (not (slime-busy-p)))
    287      (let ((names (enclosing-operator-names)))
    288        (when names
    289          (slime-eval-async
    290           `(swank:arglist-for-echo-area (quote ,names))
    291           #'(lambda (message)
    292              (when (stringp message)
    293                (status (string-trim '(#\") message))))))))
    294    (insert #\space)))
     283      (when (and (slime-connected-p)
     284                 (not (slime-busy-p)))
     285        (let ((names (enclosing-operator-names (current-point))))
     286          (when names
     287            (slime-eval-async
     288             `(swank:arglist-for-echo-area (quote ,names))
     289             #'(lambda (message)
     290                (when (stringp message)
     291                  (status (string-trim '(#\") message))))))))
     292    (insert #\space)))
    295293
    296294(defun find-buffer-package ()
     
    376374      (return-from slime-edit-definition)))
    377375  (unless function-name
    378     (setf function-name (string-upcase (symbol-name-at-point))))
     376    (setf function-name (string-upcase (symbol-name-at-mark (current-point)))))
    379377  (when function-name
    380378    (setf function-name (string function-name))
     
    448446(map-key-for-mode "Ctrl Alt I" "(slime:slime-complete-symbol)" "Lisp")
    449447(map-key-for-mode "Space" "(slime:slime-space)" "Lisp Shell")
    450 ;; (map-key-for-mode "Space" "(slime:slime-space)" "Lisp")
     448(map-key-for-mode "Space" "(slime:slime-space)" "Lisp")
    451449(map-key-for-mode "Alt ." "(slime:slime-edit-definition)" "Lisp Shell")
    452450(map-key-for-mode "Alt ." "(slime:slime-edit-definition)" "Lisp")
Note: See TracChangeset for help on using the changeset viewer.