/[slime]/slime/swank.lisp
ViewVC logotype

Diff of /slime/swank.lisp

Parent Directory Parent Directory | Revision Log Revision Log | View Patch Patch

revision 1.398 by mbaringer, Wed Sep 13 15:25:17 2006 UTC revision 1.399 by mbaringer, Mon Sep 18 21:27:49 2006 UTC
# Line 1349  Return the symbol and a flag indicating Line 1349  Return the symbol and a flag indicating
1349    (multiple-value-bind (symbol status) (parse-symbol string package)    (multiple-value-bind (symbol status) (parse-symbol string package)
1350      (if status      (if status
1351          (values symbol status)          (values symbol status)
1352          (error "Unknown symbol: ~A [in ~A]" string package))))          (abort-request "Unknown symbol: ~A [in ~A]" string package))))
1353    
1354  ;; FIXME: interns the name  ;; FIXME: interns the name
1355  (defun parse-package (string)  (defun parse-package (string)
# Line 1608  Return three values: keyword, argument n Line 1608  Return three values: keyword, argument n
1608                             (car arg)                             (car arg)
1609                             (cadr arg)))                             (cadr arg)))
1610          (t          (t
1611           (error "Bad keyword item of formal argument list"))))           (abort-request "Bad keyword item of formal argument list"))))
1612    
1613  (defun encode-keyword-arg (arg)  (defun encode-keyword-arg (arg)
1614    (cond    (cond
# Line 2369  The secondary value indicates the absenc Line 2369  The secondary value indicates the absenc
2369    "Get the result of the previous REPL evaluation with ID."    "Get the result of the previous REPL evaluation with ID."
2370    (multiple-value-bind (object foundp) (lookup-presented-object id)    (multiple-value-bind (object foundp) (lookup-presented-object id)
2371      (cond (foundp object)      (cond (foundp object)
2372            (t (error "Attempt to access unrecorded object (id ~D)." id)))))            (t (abort-request "Attempt to access unrecorded object (id ~D)." id)))))
2373    
2374  (defslimefun clear-repl-results ()  (defslimefun clear-repl-results ()
2375    "Forget the results of all previous REPL evaluations."    "Forget the results of all previous REPL evaluations."
# Line 2395  Errors are trapped and invoke our debugg Line 2395  Errors are trapped and invoke our debugg
2395    (call-with-debugger-hook    (call-with-debugger-hook
2396     #'swank-debugger-hook     #'swank-debugger-hook
2397     (lambda ()     (lambda ()
2398       (let (ok result)       (let (ok result reason)
2399         (unwind-protect         (unwind-protect
2400              (let ((*buffer-package* (guess-buffer-package buffer-package))              (let ((*buffer-package* (guess-buffer-package buffer-package))
2401                    (*buffer-readtable* (guess-buffer-readtable buffer-package))                    (*buffer-readtable* (guess-buffer-readtable buffer-package))
# Line 2404  Errors are trapped and invoke our debugg Line 2404  Errors are trapped and invoke our debugg
2404                (check-type *buffer-readtable* readtable)                (check-type *buffer-readtable* readtable)
2405                ;; APPLY would be cleaner than EVAL.                ;; APPLY would be cleaner than EVAL.
2406                ;;(setq result (apply (car form) (cdr form)))                ;;(setq result (apply (car form) (cdr form)))
2407                (setq result (eval form))                (handler-case
2408                (finish-output)                    (progn
2409                (run-hook *pre-reply-hook*)                      (setq result (eval form))
2410                (setq ok t))                      (run-hook *pre-reply-hook*)
2411                        (finish-output)
2412                        (setq ok t))
2413                    (request-abort (c)
2414                      (setf ok nil
2415                            reason (list (slot-value c 'swank-backend::reason))))))
2416           (force-user-output)           (force-user-output)
2417           (send-to-emacs `(:return ,(current-thread)           (send-to-emacs `(:return ,(current-thread)
2418                                    ,(if ok `(:ok ,result) '(:abort))                                    ,(if ok
2419                                           `(:ok ,result)
2420                                           `(:abort ,@reason))
2421                                    ,id)))))))                                    ,id)))))))
2422    
2423  (defvar *echo-area-prefix* "=> "  (defvar *echo-area-prefix* "=> "
# Line 3666  FUZZY-COMPLETIONS, format the list into Line 3673  FUZZY-COMPLETIONS, format the list into
3673  The result is a list of property lists."  The result is a list of property lists."
3674    (let ((package (if package    (let ((package (if package
3675                       (or (find-package (string-to-package-designator package))                       (or (find-package (string-to-package-designator package))
3676                           (error "No such package: ~S" package)))))                           (abort-request "No such package: ~S" package)))))
3677      (mapcan (listify #'briefly-describe-symbol-for-emacs)      (mapcan (listify #'briefly-describe-symbol-for-emacs)
3678              (sort (remove-duplicates              (sort (remove-duplicates
3679                     (apropos-symbols name external-only case-sensitive package))                     (apropos-symbols name external-only case-sensitive package))

Legend:
Removed from v.1.398  
changed lines
  Added in v.1.399

  ViewVC Help
Powered by ViewVC 1.1.5