I get bounces from naver.com for netscou...@naver.com in Korean. Google translate indicates that this e-mail has blocked mail from the list address. Would it be possible to remove the recipient from the list, in order to avoid the bounces?
Greetings, Peter
--- Begin Message ---NAVER - http://www.naver.com/ -------------------------------------------- netscou...@naver.com 님께 보내신 메일 <[MIT-Scheme-devel] Patches for current Swank> 이 다음과 같은 이유로 전송 실패했습니다. -------------------------------------------- 받는 사람이 회원님의 메일을 수신차단 하였습니다. ----------------------------------------------- Begin Message ---Hello fellow Schemers! Yesterday I've tried to get current SLIME (2012-03-06 here) to work with MIT/GNU Scheme, and fixed a few things. Find attached my patches. How should I best prepare them so they get a chance at getting accepted into GIT? Greetings, PeterFrom 203f5ab2624f366b41b0dcd144f1fa30b03bd746 Mon Sep 17 00:00:00 2001 From: Peter Feigl <cra...@gmx.net> Date: Wed, 2 May 2012 09:20:12 +0200 Subject: [PATCH 1/2] Updating swank for version 2012-03-26 The following things were fixed / updated: - various fixes to make swank work at all - the directory functions were implemented (cd, +d, -d, !d) - rudimentary autodoc support was added (displays the output of PA) - apropos format apparently changed, fixed There is still a problem with restarts that require parameters and nested restarts. --- src/runtime/swank.scm | 158 ++++++++++++++++++++++++++++++++++++++++--------- 1 file changed, 130 insertions(+), 28 deletions(-) diff --git a/src/runtime/swank.scm b/src/runtime/swank.scm index eab8a55..0a26562 100644 --- a/src/runtime/swank.scm +++ b/src/runtime/swank.scm @@ -7,8 +7,8 @@ License as distributed with Emacs (press C-h C-c for details). Copyright (C) 1986, 1987, 1988, 1989, 1990, 1991, 1992, 1993, 1994, 1995, 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004, 2005, - 2006, 2007, 2008, 2009, 2010, 2011, 2012 Massachusetts Institute - of Technology + 2006, 2007, 2008, 2009, 2010, 2011 Massachusetts Institute of + Technology This file is part of MIT/GNU Scheme. @@ -34,7 +34,7 @@ USA. ;;; Suggested for .emacs: #| -\(when (require 'slime nil t) +(when (require 'slime nil t) (defun mit-scheme-start-swank (file encoding) (format "%S\n\n" `(start-swank ,file))) @@ -60,7 +60,6 @@ USA. (setq slime-default-lisp 'mit-scheme) (add-hook 'scheme-mode-hook 'mit-scheme-slime-mode-init)) |# - (declare (usual-integrations)) (define (start-swank #!optional port-file) @@ -201,20 +200,39 @@ USA. (lambda (k) (bind-condition-handler (list condition-type:serious-condition) (lambda (condition) - (invoke-sldb socket (+ level 1) condition) - (write-message `(:return (:abort) ,id) socket) - (k unspecific)) + (dynamic-wind + (lambda () + #f) + (lambda () + (invoke-sldb socket (+ level 1) condition)) + (lambda () + (write-message `(:return (:abort ,(condition/report-string condition)) ,id) socket))) +; (k unspecific) + ) (lambda () - (write-message `(:return (:ok ,(emacs-rex socket sexp pstring)) + (write-message `(:return (:ok ,(emacs-rex socket sexp pstring id)) ,id) socket))))))) -(define (emacs-rex socket sexp pstring) - (fluid-let ((*buffer-pstring* pstring)) - (eval (cons* (car sexp) socket (cdr sexp)) +;; quote keywords, t and nil +(define (quote-special x) + (if (and (symbol? x) + (or + (and (> (string-length (symbol->string x)) 0) + (char=? #\: (string-ref (symbol->string x) 0))) + (eq? x 't) + (eq? x 'nil))) + `(quote ,x) + x)) + +(define (emacs-rex socket sexp pstring id) + (fluid-let ((*buffer-pstring* pstring) + (*index* id)) + (eval (cons* (car sexp) socket (map quote-special (cdr sexp))) swank-env))) (define *buffer-pstring*) +(define *index*) (define swank-env (the-environment)) @@ -361,7 +379,8 @@ USA. (define (swank:load-file socket file) (with-output-to-repl socket (lambda () - (load file (buffer-env))))) + (load file (buffer-env)) + 't))) (define (swank:disassemble-symbol socket string) socket @@ -381,8 +400,8 @@ USA. (list pstring pstring)))) (define (swank:create-repl socket . args) - socket args - (let ((pstring (env->pstring (make-top-level-environment)))) + socket ; args + (let ((pstring (env->pstring (->environment '(user))))) (list pstring pstring))) (define (swank:swank-macroexpand-all socket string) @@ -419,8 +438,12 @@ USA. :package (:name ,pstring :prompt ,pstring) :lisp-implementation (:type "MIT/GNU Scheme" - :version ,(get-subsystem-version-string "release")) - :version "20100404"))) + :version ,(get-subsystem-version-string "release") + :name "mit-scheme") + :encoding + (:coding-systems + ("utf-8-unix" "iso-latin-1-unix")) + :version "2012-03-26"))) (define (swank:quit-lisp socket) socket @@ -517,10 +540,10 @@ swank:xref socket) (sldb-loop level socket)) (lambda () - (write-message `(:debug-return 0 ,(- level 1) 'NIL) socket))))) + (write-message `(:debug-return 0 ,(- level 1) nil) socket))))) (define (sldb-loop level socket) - (write-message `(:debug-activate 0 ,level) socket) + (write-message `(:debug-activate 0 ,level nil) socket) (with-simple-restart 'ABORT (string "Return to SLDB level " level ".") (lambda () (process-one-message socket level))) @@ -535,7 +558,7 @@ swank:xref (sldb-restarts rs) (sldb-backtrace c start end) ;;'((0 "dummy frame")) - '()))) + (list *index*)))) (define (sldb-restarts restarts) (map (lambda (r) @@ -558,6 +581,8 @@ swank:xref (define (swank:invoke-nth-restart-for-emacs socket sldb-level n) socket sldb-level + ;; is the :abort message correct here? + (write-message `(:return (:abort "NIL") ,*index*) socket) (invoke-restart (list-ref (sldb-state.restarts *sldb-state*) n))) (define (swank:debugger-info-for-emacs socket from to) @@ -711,17 +736,17 @@ swank:xref system-global-environment (pstring->env pstring)))) (map (lambda (symbol) - `((:designator ,(string symbol " " pstring)) + `(:designator ,(symbol->string symbol) ,@(case (environment-reference-type env symbol) ((UNBOUND) '()) - ((UNASSIGNED) `((:variable nil))) - ((MACRO) `((:macro nil))) + ((UNASSIGNED) `(:variable nil)) + ((MACRO) `(:macro nil)) (else (let ((v (environment-lookup env symbol))) - `((,(cond ((generic-procedure? v) ':generic-function) - ((procedure? v) ':function) - (else ':variable)) - ,v))))))) + `(,(cond ((generic-procedure? v) ':generic-function) + ((procedure? v) ':function) + (else ':variable)) + ,(with-output-to-string (lambda () (write v))))))))) (apropos-list text env #t)))) (define (swank:list-all-package-names socket . args) @@ -953,7 +978,6 @@ swank:xref (define (elisp-true? o) (not (elisp-false? o))) (define nil '()) -(define t 'T) (define (->line o) (let ((r (write-to-string o 100))) @@ -970,4 +994,82 @@ swank:xref (fluid-let ((*unparser-list-breadth-limit* 10) (*unparser-list-depth-limit* 4) (*unparser-string-length-limit* 100)) - (pp o p))))) \ No newline at end of file + (pp o p))))) + +(define (swank:swank-require socket packages) + socket + packages + '()) + +(define (find-string-before-swank-cursor-marker expr) + (if (list? expr) + (if (member 'swank::%cursor-marker% expr) + (if (string? (car expr)) + (car expr) + #f) + (any (lambda (ex) + (find-string-before-swank-cursor-marker ex)) + expr)) + #f)) + +(define swank-extra-documentation + '((let bindings . body) + (define name . body) + (if test then else) + (set! name value))) + +(define (swank:autodoc socket expr . params) + socket params + (let* ((op-string (find-string-before-swank-cursor-marker expr))) + (if op-string + (let* ((op (string->symbol op-string)) + (type (environment-reference-type (get-current-environment) op))) + (let ((ans (if (eq? type 'normal) + (cons op (with-input-from-string (string-trim (with-output-to-string + (lambda () (pa (eval op (get-current-environment)))))) + (lambda () (read)))) + (let ((extra (assq op swank-extra-documentation))) + (if extra + extra + #f))))) + (let ((answer (if ans (with-output-to-string (lambda () (write ans))) ':not-available))) + (list answer 't)))) + (list ':not-available 't)))) + +(define (swank:completions socket string pstring) + socket + (let ((strings (all-completions string (pstring->env pstring)))) + (list (sort strings string<?) + (longest-common-prefix strings)))) + +(define (swank:set-default-directory socket directory) + (->namestring (set-working-directory-pathname! directory))) + +(define (swank:compile-file-if-needed socket file dummy?) + ;; TODO: fix this, output should go to swank, loading should load the compiled file + (cf file) + (load file) + 't) + +(define (swank:default-directory socket) + (->namestring (working-directory-pathname))) + +(define (swank:describe-symbol socket symbol) + "not implemented") + +(define (swank:describe-function socket function) + (swank:describe-symbol socket function)) + +(define (swank:describe-definition-for-emacs socket name type) + type + (swank:describe-symbol socket name)) + +(define swank:swank-expand-1 swank:swank-macroexpand-all) + +(define swank:swank-compiler-macroexpand-1 swank:swank-macroexpand-all) + +(define swank:swank-compiler-macroexpand swank:swank-macroexpand-all) + +#| +TODOs: +- support ! which expands to (swank:listener-eval "(cl:defparameter x 5 \"REPL generated global variable.\")\n") -- 1.7.10From ef14bf5c1ebd4ac1c5f8d2f982e29af723b1c7da Mon Sep 17 00:00:00 2001 From: Peter Feigl <cra...@gmx.net> Date: Wed, 2 May 2012 09:25:34 +0200 Subject: [PATCH 2/2] adding missing closing comment --- src/runtime/swank.scm | 1 + 1 file changed, 1 insertion(+) diff --git a/src/runtime/swank.scm b/src/runtime/swank.scm index 0a26562..c697d06 100644 --- a/src/runtime/swank.scm +++ b/src/runtime/swank.scm @@ -1073,3 +1073,4 @@ swank:xref #| TODOs: - support ! which expands to (swank:listener-eval "(cl:defparameter x 5 \"REPL generated global variable.\")\n") +|# \ No newline at end of file -- 1.7.10
pgpH0iz9kQRIf.pgp
Description: PGP signature_______________________________________________ MIT-Scheme-devel mailing list MIT-Scheme-devel@gnu.org https://lists.gnu.org/mailman/listinfo/mit-scheme-devel
--- End Message ---
--- End Message ---
pgpbkgG0KvBcC.pgp
Description: PGP signature
_______________________________________________ MIT-Scheme-devel mailing list MIT-Scheme-devel@gnu.org https://lists.gnu.org/mailman/listinfo/mit-scheme-devel
