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

Work in progress.

File:
1 edited

Legend:

Unmodified
Added
Removed
  • 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.