From sboukarev at common-lisp.net Wed Sep 1 13:18:55 2010 From: sboukarev at common-lisp.net (CVS User sboukarev) Date: Wed, 01 Sep 2010 09:18:55 -0400 Subject: [slime-cvs] CVS slime Message-ID: Update of /project/slime/cvsroot/slime In directory cl-net:/tmp/cvs-serv15385 Modified Files: ChangeLog swank-sbcl.lisp Log Message: * swank-sbcl.lisp (background-save-image): add #-win32, because it uses symbols not present on win32. Reported by Holly Styles. --- /project/slime/cvsroot/slime/ChangeLog 2010/08/31 23:44:40 1.2134 +++ /project/slime/cvsroot/slime/ChangeLog 2010/09/01 13:18:55 1.2135 @@ -1,3 +1,9 @@ +2010-09-01 Stas Boukarev + + * swank-sbcl.lisp (background-save-image): add #-win32, because it + uses symbols not present on win32. + Reported by Holly Styles. + 2010-08-31 Stas Boukarev * swank-cmucl.lisp (foreign-frame-p, gdb-exec, frame-ip): Sparc --- /project/slime/cvsroot/slime/swank-sbcl.lisp 2010/08/31 10:33:15 1.276 +++ /project/slime/cvsroot/slime/swank-sbcl.lisp 2010/09/01 13:18:55 1.277 @@ -1630,8 +1630,9 @@ :dual-channel-p t :external-format external-format)) -(defimplementation background-save-image (filename &key restart-function - completion-function) +#-win32 +(defimplementation background-save-image (filename &key restart-function + completion-function) (flet ((restart-sbcl () (sb-debug::enable-debugger) (setf sb-impl::*descriptor-handlers* nil) From sboukarev at common-lisp.net Thu Sep 2 17:21:09 2010 From: sboukarev at common-lisp.net (CVS User sboukarev) Date: Thu, 02 Sep 2010 13:21:09 -0400 Subject: [slime-cvs] CVS slime Message-ID: Update of /project/slime/cvsroot/slime In directory cl-net:/tmp/cvs-serv32510 Modified Files: ChangeLog swank-cmucl.lisp Log Message: * swank-cmucl.lisp: #-cmu19 -> #+cmu18, cmu18 is allegedly the oldest supported CMUCL. --- /project/slime/cvsroot/slime/ChangeLog 2010/09/01 13:18:55 1.2135 +++ /project/slime/cvsroot/slime/ChangeLog 2010/09/02 17:21:09 1.2136 @@ -1,3 +1,8 @@ +2010-09-02 Stas Boukarev + + * swank-cmucl.lisp: #-cmu19 -> #+cmu18, cmu18 is allegedly the + oldest supported CMUCL. + 2010-09-01 Stas Boukarev * swank-sbcl.lisp (background-save-image): add #-win32, because it --- /project/slime/cvsroot/slime/swank-cmucl.lisp 2010/08/31 23:44:40 1.229 +++ /project/slime/cvsroot/slime/swank-cmucl.lisp 2010/09/02 17:21:09 1.230 @@ -27,7 +27,7 @@ ;;; `READ-SEQUENCE' with large sequences has problems in 18e. This new ;;; definition works better. -#-cmu19 +#+cmu18 (progn (let ((s (find-symbol (string :*enable-package-locked-errors*) :lisp))) (when s @@ -577,7 +577,7 @@ ;;; More types of XREF information were added since 18e: ;;; -#+cmu19 +#-cmu18 (progn (defxref who-macroexpands xref:who-macroexpands) ;; XXX @@ -613,8 +613,8 @@ (when c:*record-xref-info* (let ((filename (truename namestring))) (dolist (db (list xref::*who-calls* - #+cmu19 xref::*who-is-called* - #+cmu19 xref::*who-macroexpands* + #-cmu18 xref::*who-is-called* + #-cmu18 xref::*who-macroexpands* xref::*who-references* xref::*who-binds* xref::*who-sets*)) From heller at common-lisp.net Fri Sep 3 07:25:19 2010 From: heller at common-lisp.net (CVS User heller) Date: Fri, 03 Sep 2010 03:25:19 -0400 Subject: [slime-cvs] CVS slime Message-ID: Update of /project/slime/cvsroot/slime In directory cl-net:/tmp/cvs-serv10017 Modified Files: ChangeLog slime.el swank.lisp Log Message: For C-c C-k, ask before loading possibly broken fasl files. * slime.el (slime-compilation-result): Add 2 slots: loadp and faslfile. (slime-compilation-finished): Use them to load the faslfile. * swank.lisp (:compilation-result): Add 2 slots. Use keyword constructor. (compile-file-for-emacs): Return loadp and faslfile to Emacs. (collect-notes): Pass loadp and falsfile along. --- /project/slime/cvsroot/slime/ChangeLog 2010/09/02 17:21:09 1.2136 +++ /project/slime/cvsroot/slime/ChangeLog 2010/09/03 07:25:19 1.2137 @@ -1,3 +1,15 @@ +2010-09-03 Helmut Eller + + For C-c C-k, ask before loading possibly broken fasl files. + + * slime.el (slime-compilation-result): Add 2 slots: loadp and + faslfile. + (slime-compilation-finished): Use them to load the faslfile. + * swank.lisp (:compilation-result): Add 2 slots. Use keyword + constructor. + (compile-file-for-emacs): Return loadp and faslfile to Emacs. + (collect-notes): Pass loadp and falsfile along. + 2010-09-02 Stas Boukarev * swank-cmucl.lisp: #-cmu19 -> #+cmu18, cmu18 is allegedly the --- /project/slime/cvsroot/slime/slime.el 2010/08/22 10:51:11 1.1336 +++ /project/slime/cvsroot/slime/slime.el 2010/09/03 07:25:19 1.1337 @@ -2553,7 +2553,7 @@ (:conc-name slime-compilation-result.) (:constructor nil) (:copier nil)) - tag notes successp duration) + tag notes successp duration loadp faslfile) (defvar slime-last-compilation-result nil "The result of the most recently issued compilation.") @@ -2649,12 +2649,17 @@ #'slime-compilation-finished)) (defun slime-compilation-finished (result) - (with-struct (slime-compilation-result. notes duration successp) result + (with-struct (slime-compilation-result. notes duration successp + loadp faslfile) result (setf slime-last-compilation-result result) (slime-show-note-counts notes duration successp) (when slime-highlight-compiler-notes (slime-highlight-notes notes)) - (run-hook-with-args 'slime-compilation-finished-hook notes))) + (run-hook-with-args 'slime-compilation-finished-hook notes) + (when (and loadp faslfile + (or successp + (y-or-n-p "Compilation failed. Load fasl file anyway? "))) + (slime-eval-async `(swank:load-file ,faslfile))))) (defun slime-show-note-counts (notes secs successp) (message (concat --- /project/slime/cvsroot/slime/swank.lisp 2010/08/15 19:13:57 1.725 +++ /project/slime/cvsroot/slime/swank.lisp 2010/09/03 07:25:19 1.726 @@ -2760,11 +2760,12 @@ ;;;; Compilation Commands. (defstruct (:compilation-result - (:type list) :named - (:constructor make-compilation-result (notes successp duration))) + (:type list) :named) notes (successp nil :type boolean) - (duration 0.0 :type float)) + (duration 0.0 :type float) + (loadp nil :type boolean) + (faslfile nil :type (or null string))) (defun measure-time-interval (fun) "Call FUN and return the first return value and the elapsed time. @@ -2788,16 +2789,24 @@ (defun collect-notes (function) (let ((notes '())) - (multiple-value-bind (successp seconds) + (multiple-value-bind (result seconds) (handler-bind ((compiler-condition (lambda (c) (push (make-compiler-note c) notes)))) (measure-time-interval (lambda () - ;; To report location of error-signaling toplevel forms - ;; for errors in EVAL-WHEN or during macroexpansion. - (with-simple-restart (abort "Abort compilation.") - (funcall function))))) - (make-compilation-result (reverse notes) (and successp t) seconds)))) + ;; To report location of error-signaling toplevel forms + ;; for errors in EVAL-WHEN or during macroexpansion. + (restart-case (multiple-value-list (funcall function)) + (abort () :report "Abort compilation." (list nil)))))) + (destructuring-bind (successp &optional loadp faslfile) result + (let ((faslfile (etypecase faslfile + (null nil) + (pathname (pathname-to-filename faslfile))))) + (make-compilation-result :notes (reverse notes) + :duration seconds + :successp (if successp t) + :loadp (if loadp t) + :faslfile faslfile)))))) (defslimefun compile-file-for-emacs (filename load-p &rest options &key policy &allow-other-keys) @@ -2811,12 +2820,12 @@ (multiple-value-bind (output-pathname warnings? failure?) (swank-compile-file pathname (fasl-pathname pathname options) - load-p + nil (or (guess-external-format pathname) :default) :policy policy) - (declare (ignore output-pathname warnings?)) - (not failure?))))))) + (declare (ignore warnings?)) + (values (not failure?) load-p output-pathname))))))) (defvar *fasl-pathname-function* nil "In non-nil, use this function to compute the name for fasl-files.") From heller at common-lisp.net Fri Sep 3 07:25:24 2010 From: heller at common-lisp.net (CVS User heller) Date: Fri, 03 Sep 2010 03:25:24 -0400 Subject: [slime-cvs] CVS slime/contrib Message-ID: Update of /project/slime/cvsroot/slime/contrib In directory cl-net:/tmp/cvs-serv10065/contrib Modified Files: ChangeLog swank-kawa.scm Log Message: * swank-kawa.scm (%%runnable): Update for changes in SVN version. --- /project/slime/cvsroot/slime/contrib/ChangeLog 2010/08/21 21:34:12 1.409 +++ /project/slime/cvsroot/slime/contrib/ChangeLog 2010/09/03 07:25:24 1.410 @@ -1,3 +1,7 @@ +2010-09-03 Helmut Eller + + * swank-kawa.scm (%%runnable): Update for changes in SVN version. + 2010-08-21 Stas Boukarev * slime-fuzzy.el (slime-fuzzy-choices-buffer): XEmacs compatibility. --- /project/slime/cvsroot/slime/contrib/swank-kawa.scm 2010/05/28 10:49:35 1.22 +++ /project/slime/cvsroot/slime/contrib/swank-kawa.scm 2010/09/03 07:25:24 1.23 @@ -484,8 +484,6 @@ ;;; FIXME: not thread safe (df %read ((port ) (table )) - ;; (parameterize ((current-readtable table)) - ;; (read))) (let ((old (gnu.kawa.lispexpr.ReadTable:getCurrent))) (try-finally (seq (gnu.kawa.lispexpr.ReadTable:setCurrent table) @@ -1274,7 +1272,7 @@ (log "exception-catch-location: ~s\n" (src-loc>str (! catch-location e))) (let ((l (! catch-location e))) (cond ((or (nul? l) - ;; (member (! source-path l) '("gnu/expr/ModuleExp.java") + ;; (member (! source-path l) '("gnu/expr/ModuleExp.java")) ) (process-exception e c state)) (#t @@ -1746,10 +1744,11 @@ thread)) (df %%runnable (f => ) - ( f) - ;;( f) + ;;( f) + ( f) ) +#| (df %runnable (f => ) ( (fun () @@ -1758,6 +1757,7 @@ (log "exception in thread ~s: ~s" (current-thread) ex) (! printStackTrace ex)))))) +|# (df chan () (let ((lock ()) @@ -1866,6 +1866,7 @@ ,(map (fun (e) (! to-string e)) (array-to-list (! get-stack-trace ex)))))))))) +#| (define-simple-class () (f :: ) ((*init* (f )) @@ -1875,6 +1876,7 @@ (! set-environment-raw (:getInstance) (@ environment (this))) (! apply0 f))) +|# ;;;; Logging From sboukarev at common-lisp.net Fri Sep 3 18:53:12 2010 From: sboukarev at common-lisp.net (CVS User sboukarev) Date: Fri, 03 Sep 2010 14:53:12 -0400 Subject: [slime-cvs] CVS slime/contrib Message-ID: Update of /project/slime/cvsroot/slime/contrib In directory cl-net:/tmp/cvs-serv18533 Modified Files: ChangeLog slime-repl.el Log Message: * slime-repl.el (slime-repl-mode-end-of-defun) (slime-repl-mode-beginning-of-defun): Take an optional argument which specifies how many defuns it should move. GNU Emacs catches wrong-number-of-arguments condition and does this by itself, but XEmacs doesn't. --- /project/slime/cvsroot/slime/contrib/ChangeLog 2010/09/03 07:25:24 1.410 +++ /project/slime/cvsroot/slime/contrib/ChangeLog 2010/09/03 18:53:11 1.411 @@ -1,3 +1,11 @@ +2010-09-03 Stas Boukarev + + * slime-repl.el (slime-repl-mode-end-of-defun) + (slime-repl-mode-beginning-of-defun): Take an optional argument + which specifies how many defuns it should move. GNU Emacs catches + wrong-number-of-arguments condition and does this by itself, but + XEmacs doesn't. + 2010-09-03 Helmut Eller * swank-kawa.scm (%%runnable): Update for changes in SVN version. --- /project/slime/cvsroot/slime/contrib/slime-repl.el 2010/08/21 06:40:12 1.48 +++ /project/slime/cvsroot/slime/contrib/slime-repl.el 2010/09/03 18:53:12 1.49 @@ -502,13 +502,17 @@ (interactive) (slime-switch-to-output-buffer)) -(defun slime-repl-mode-beginning-of-defun () - (slime-repl-previous-prompt) - t) - -(defun slime-repl-mode-end-of-defun () - (slime-repl-next-prompt) - t) +(defun slime-repl-mode-beginning-of-defun (&optional arg) + (if (and arg (< arg 0)) + (slime-repl-mode-end-of-defun (- arg)) + (dotimes (i (or arg 1)) + (slime-repl-previous-prompt)))) + +(defun slime-repl-mode-end-of-defun (&optional arg) + (if (and arg (< arg 0)) + (slime-repl-mode-beginning-of-defun (- arg)) + (dotimes (i (or arg 1)) + (slime-repl-next-prompt)))) (defun slime-repl-send-string (string &optional command-string) (cond (slime-repl-read-mode From sboukarev at common-lisp.net Fri Sep 3 19:04:28 2010 From: sboukarev at common-lisp.net (CVS User sboukarev) Date: Fri, 03 Sep 2010 15:04:28 -0400 Subject: [slime-cvs] CVS slime/contrib Message-ID: Update of /project/slime/cvsroot/slime/contrib In directory cl-net:/tmp/cvs-serv22164 Modified Files: ChangeLog slime-repl.el Log Message: * slime-repl.el (slime-search-property-change): XEmacs may return nil on previous/next-single-char-property-change, don't pass it to goto-char. --- /project/slime/cvsroot/slime/contrib/ChangeLog 2010/09/03 18:53:11 1.411 +++ /project/slime/cvsroot/slime/contrib/ChangeLog 2010/09/03 19:04:28 1.412 @@ -1,5 +1,11 @@ 2010-09-03 Stas Boukarev + * slime-repl.el (slime-search-property-change): XEmacs may return + nil on previous/next-single-char-property-change, don't pass it to + goto-char. + +2010-09-03 Stas Boukarev + * slime-repl.el (slime-repl-mode-end-of-defun) (slime-repl-mode-beginning-of-defun): Take an optional argument which specifies how many defuns it should move. GNU Emacs catches --- /project/slime/cvsroot/slime/contrib/slime-repl.el 2010/09/03 18:53:12 1.49 +++ /project/slime/cvsroot/slime/contrib/slime-repl.el 2010/09/03 19:04:28 1.50 @@ -681,10 +681,12 @@ (goto-char origin)))) (defun slime-search-property-change (prop &optional backward) - (cond (backward - (goto-char (previous-single-char-property-change (point) prop))) - (t - (goto-char (next-single-char-property-change (point) prop))))) + (cond (backward + (goto-char (or (previous-single-char-property-change (point) prop) + (point-min)))) + (t + (goto-char (or (next-single-char-property-change (point) prop) + (point-max)))))) (defun slime-end-of-proprange-p (property) (and (get-char-property (max 1 (1- (point))) property) From sboukarev at common-lisp.net Fri Sep 3 22:29:43 2010 From: sboukarev at common-lisp.net (CVS User sboukarev) Date: Fri, 03 Sep 2010 18:29:43 -0400 Subject: [slime-cvs] CVS slime Message-ID: Update of /project/slime/cvsroot/slime In directory cl-net:/tmp/cvs-serv9950 Modified Files: ChangeLog slime.el Log Message: * slime.el (slime-forward-cruft): Use " \t\n" to match whitespaces instead of [:space:], XEmacs compatibility. --- /project/slime/cvsroot/slime/ChangeLog 2010/09/03 07:25:19 1.2137 +++ /project/slime/cvsroot/slime/ChangeLog 2010/09/03 22:29:43 1.2138 @@ -1,3 +1,8 @@ +2010-09-03 Stas Boukarev + + * slime.el (slime-forward-cruft): Use " \t\n" to match whitespaces + instead of [:space:], XEmacs compatibility. + 2010-09-03 Helmut Eller For C-c C-k, ask before loading possibly broken fasl files. --- /project/slime/cvsroot/slime/slime.el 2010/09/03 07:25:19 1.1337 +++ /project/slime/cvsroot/slime/slime.el 2010/09/03 22:29:43 1.1338 @@ -8435,7 +8435,7 @@ (defun slime-forward-cruft () "Move forward over whitespace, comments, reader conditionals." - (while (slime-point-moves-p (skip-chars-forward "[:space:]") + (while (slime-point-moves-p (skip-chars-forward " \t\n") (forward-comment (buffer-size)) (inline (slime-forward-reader-conditional))))) From sboukarev at common-lisp.net Sat Sep 4 00:32:14 2010 From: sboukarev at common-lisp.net (CVS User sboukarev) Date: Fri, 03 Sep 2010 20:32:14 -0400 Subject: [slime-cvs] CVS slime/contrib Message-ID: Update of /project/slime/cvsroot/slime/contrib In directory cl-net:/tmp/cvs-serv12229 Modified Files: ChangeLog swank-fuzzy.lisp Log Message: * swank-fuzzy.lisp (*fuzzy-completion-...*): Change defparameter to defvar for easier customization. --- /project/slime/cvsroot/slime/contrib/ChangeLog 2010/09/03 19:04:28 1.412 +++ /project/slime/cvsroot/slime/contrib/ChangeLog 2010/09/04 00:32:14 1.413 @@ -1,3 +1,8 @@ +2010-09-04 Stas Boukarev + + * swank-fuzzy.lisp (*fuzzy-completion-...*): Change defparameter + to defvar for easier customization. + 2010-09-03 Stas Boukarev * slime-repl.el (slime-search-property-change): XEmacs may return --- /project/slime/cvsroot/slime/contrib/swank-fuzzy.lisp 2010/04/19 00:42:29 1.10 +++ /project/slime/cvsroot/slime/contrib/swank-fuzzy.lisp 2010/09/04 00:32:14 1.11 @@ -521,15 +521,15 @@ ;;;;; Fuzzy completion scoring -(defparameter *fuzzy-completion-symbol-prefixes* "*+-%&?<" +(defvar *fuzzy-completion-symbol-prefixes* "*+-%&?<" "Letters that are likely to be at the beginning of a symbol. Letters found after one of these prefixes will be scored as if they were at the beginning of ths symbol.") -(defparameter *fuzzy-completion-symbol-suffixes* "*+->" +(defvar *fuzzy-completion-symbol-suffixes* "*+->" "Letters that are likely to be at the end of a symbol. Letters found before one of these suffixes will be scored as if they were at the end of the symbol.") -(defparameter *fuzzy-completion-word-separators* "-/." +(defvar *fuzzy-completion-word-separators* "-/." "Letters that separate different words in symbols. Letters after one of these symbols will be scores more highly than other letters.") @@ -622,4 +622,4 @@ (format t "~&~VA score ~8,2F ~A" max-len (highlight-completion result sym) score result)))) -(provide :swank-fuzzy) \ No newline at end of file +(provide :swank-fuzzy) From sboukarev at common-lisp.net Tue Sep 7 03:02:22 2010 From: sboukarev at common-lisp.net (CVS User sboukarev) Date: Mon, 06 Sep 2010 23:02:22 -0400 Subject: [slime-cvs] CVS slime/contrib Message-ID: Update of /project/slime/cvsroot/slime/contrib In directory cl-net:/tmp/cvs-serv17507 Modified Files: ChangeLog swank-c-p-c.lisp Log Message: * swank-c-p-c.lisp (untokenize-completion): Take an optional argument "delimiter". (longest-compound-prefix): Pass delimiter to untokenize-completion. --- /project/slime/cvsroot/slime/contrib/ChangeLog 2010/09/04 00:32:14 1.413 +++ /project/slime/cvsroot/slime/contrib/ChangeLog 2010/09/07 03:02:21 1.414 @@ -1,3 +1,9 @@ +2010-09-07 Stas Boukarev + + * swank-c-p-c.lisp (untokenize-completion): Take an optional + argument "delimiter". + (longest-compound-prefix): Pass delimiter to untokenize-completion. + 2010-09-04 Stas Boukarev * swank-fuzzy.lisp (*fuzzy-completion-...*): Change defparameter --- /project/slime/cvsroot/slime/contrib/swank-c-p-c.lisp 2009/10/31 20:18:28 1.4 +++ /project/slime/cvsroot/slime/contrib/swank-c-p-c.lisp 2010/09/07 03:02:21 1.5 @@ -249,10 +249,13 @@ (untokenize-completion (loop for token-list in (transpose-lists (mapcar #'tokenizer completions)) if (notevery #'string= token-list (rest token-list)) - collect (longest-common-prefix token-list) ; Note that we possibly collect - and do (loop-finish) ; the "" here as well, so that - else collect (first token-list))))) ; UNTOKENIZE-COMPLETION will - ; append a hyphen for us. + ;; Note that we possibly collect the "" here as well, so that + ;; UNTOKENIZE-COMPLETION will append a delimiter for us. + collect (longest-common-prefix token-list delimeter) + and do (loop-finish) + else collect (first token-list)) + delimeter))) + (defun tokenize-completion (string delimeter) "Return all substrings of STRING delimited by DELIMETER." (loop with end @@ -261,8 +264,8 @@ do (setq end (or (position delimeter string :start start) (length string))) collect (subseq string start end))) -(defun untokenize-completion (tokens) - (format nil "~{~A~^-~}" tokens)) +(defun untokenize-completion (tokens &optional (delimiter #\-)) + (format nil (format nil "~~{~~A~~^~a~~}" delimiter) tokens)) (defun transpose-lists (lists) "Turn a list-of-lists on its side. @@ -285,4 +288,4 @@ (completions (sort completion-set #'string<))) (list completions (longest-compound-prefix completions #\_)))) -(provide :swank-c-p-c) \ No newline at end of file +(provide :swank-c-p-c) From sboukarev at common-lisp.net Tue Sep 7 03:05:17 2010 From: sboukarev at common-lisp.net (CVS User sboukarev) Date: Mon, 06 Sep 2010 23:05:17 -0400 Subject: [slime-cvs] CVS slime/contrib Message-ID: Update of /project/slime/cvsroot/slime/contrib In directory cl-net:/tmp/cvs-serv17672 Modified Files: ChangeLog swank-c-p-c.lisp Log Message: * swank-c-p-c.lisp: s/delimeter/delimiter/, correct spelling. --- /project/slime/cvsroot/slime/contrib/ChangeLog 2010/09/07 03:02:21 1.414 +++ /project/slime/cvsroot/slime/contrib/ChangeLog 2010/09/07 03:05:17 1.415 @@ -1,5 +1,9 @@ 2010-09-07 Stas Boukarev + * swank-c-p-c.lisp: s/delimeter/delimiter/, correct spelling. + +2010-09-07 Stas Boukarev + * swank-c-p-c.lisp (untokenize-completion): Take an optional argument "delimiter". (longest-compound-prefix): Pass delimiter to untokenize-completion. --- /project/slime/cvsroot/slime/contrib/swank-c-p-c.lisp 2010/09/07 03:02:21 1.5 +++ /project/slime/cvsroot/slime/contrib/swank-c-p-c.lisp 2010/09/07 03:05:17 1.6 @@ -214,54 +214,54 @@ ;;;;; Compound-prefix matching -(defun make-compound-prefix-matcher (delimeter &key (test #'char=)) +(defun make-compound-prefix-matcher (delimiter &key (test #'char=)) "Returns a matching function that takes a `prefix' and a `target' string and which returns T if `prefix' is a compound-prefix of `target', and otherwise NIL. Viewing each of `prefix' and `target' as a series of substrings -delimited by DELIMETER, if each substring of `prefix' is a prefix +delimited by DELIMITER, if each substring of `prefix' is a prefix of the corresponding substring in `target' then we call `prefix' a compound-prefix of `target'. -DELIMETER may be a character, or a list of characters." - (let ((delimeters (etypecase delimeter - (character (list delimeter)) - (cons (assert (every #'characterp delimeter)) - delimeter)))) +DELIMITER may be a character, or a list of characters." + (let ((delimiters (etypecase delimiter + (character (list delimiter)) + (cons (assert (every #'characterp delimiter)) + delimiter)))) (lambda (prefix target) (declare (type simple-string prefix target)) (loop for ch across prefix with tpos = 0 always (and (< tpos (length target)) - (let ((delimeter (car (member ch delimeters :test test)))) - (if delimeter - (setf tpos (position delimeter target :start tpos)) + (let ((delimiter (car (member ch delimiters :test test)))) + (if delimiter + (setf tpos (position delimiter target :start tpos)) (funcall test ch (aref target tpos))))) do (incf tpos))))) ;;;;; Extending the input string by completion -(defun longest-compound-prefix (completions &optional (delimeter #\-)) +(defun longest-compound-prefix (completions &optional (delimiter #\-)) "Return the longest compound _prefix_ for all COMPLETIONS." - (flet ((tokenizer (string) (tokenize-completion string delimeter))) + (flet ((tokenizer (string) (tokenize-completion string delimiter))) (untokenize-completion (loop for token-list in (transpose-lists (mapcar #'tokenizer completions)) if (notevery #'string= token-list (rest token-list)) ;; Note that we possibly collect the "" here as well, so that ;; UNTOKENIZE-COMPLETION will append a delimiter for us. - collect (longest-common-prefix token-list delimeter) + collect (longest-common-prefix token-list delimiter) and do (loop-finish) else collect (first token-list)) - delimeter))) + delimiter))) -(defun tokenize-completion (string delimeter) - "Return all substrings of STRING delimited by DELIMETER." +(defun tokenize-completion (string delimiter) + "Return all substrings of STRING delimited by DELIMITER." (loop with end for start = 0 then (1+ end) until (> start (length string)) - do (setq end (or (position delimeter string :start start) (length string))) + do (setq end (or (position delimiter string :start start) (length string))) collect (subseq string start end))) (defun untokenize-completion (tokens &optional (delimiter #\-)) From sboukarev at common-lisp.net Thu Sep 9 08:28:21 2010 From: sboukarev at common-lisp.net (CVS User sboukarev) Date: Thu, 09 Sep 2010 04:28:21 -0400 Subject: [slime-cvs] CVS slime/contrib Message-ID: Update of /project/slime/cvsroot/slime/contrib In directory cl-net:/tmp/cvs-serv20470 Modified Files: ChangeLog swank-c-p-c.lisp Log Message: * swank-c-p-c.lisp (longest-compound-prefix): Wrong arguments for longest-common-prefix. Reported by Peter Stirling. --- /project/slime/cvsroot/slime/contrib/ChangeLog 2010/09/07 03:05:17 1.415 +++ /project/slime/cvsroot/slime/contrib/ChangeLog 2010/09/09 08:28:21 1.416 @@ -1,3 +1,9 @@ +2010-09-09 Stas Boukarev + + * swank-c-p-c.lisp (longest-compound-prefix): Wrong arguments for + longest-common-prefix. + Reported by Peter Stirling. + 2010-09-07 Stas Boukarev * swank-c-p-c.lisp: s/delimeter/delimiter/, correct spelling. --- /project/slime/cvsroot/slime/contrib/swank-c-p-c.lisp 2010/09/07 03:05:17 1.6 +++ /project/slime/cvsroot/slime/contrib/swank-c-p-c.lisp 2010/09/09 08:28:21 1.7 @@ -251,7 +251,7 @@ if (notevery #'string= token-list (rest token-list)) ;; Note that we possibly collect the "" here as well, so that ;; UNTOKENIZE-COMPLETION will append a delimiter for us. - collect (longest-common-prefix token-list delimiter) + collect (longest-common-prefix token-list) and do (loop-finish) else collect (first token-list)) delimiter))) From crhodes at common-lisp.net Thu Sep 16 13:24:20 2010 From: crhodes at common-lisp.net (CVS User crhodes) Date: Thu, 16 Sep 2010 09:24:20 -0400 Subject: [slime-cvs] CVS slime/contrib Message-ID: Update of /project/slime/cvsroot/slime/contrib In directory cl-net:/tmp/cvs-serv24759/contrib Modified Files: ChangeLog Added Files: slime-media.el swank-media.lisp Log Message: slime-media contrib Basically, just a hook to be able to display images in the REPL. No CL-side functionality for now (but an explanatory comment for the intrepid SLIME/CL hacker...) --- /project/slime/cvsroot/slime/contrib/ChangeLog 2010/09/09 08:28:21 1.416 +++ /project/slime/cvsroot/slime/contrib/ChangeLog 2010/09/16 13:24:20 1.417 @@ -1,3 +1,10 @@ +2010-09-16 Christophe Rhodes + + Image display support for the REPL. + + * slime-media.el: New file. + * swank-media.lisp: New file. + 2010-09-09 Stas Boukarev * swank-c-p-c.lisp (longest-compound-prefix): Wrong arguments for --- /project/slime/cvsroot/slime/contrib/slime-media.el 2010/09/16 13:24:20 NONE +++ /project/slime/cvsroot/slime/contrib/slime-media.el 2010/09/16 13:24:20 1.1 (define-slime-contrib slime-media "Display things other than text in SLIME buffers" (:authors "Christophe Rhodes ") (:license "GPL") (:slime-dependencies slime-repl) (:swank-dependencies swank-media) (:on-load (add-hook 'slime-event-hooks 'slime-dispatch-media-event))) (defun slime-dispatch-media-event (event) (destructure-case event ((:write-image image string) (let ((image (find-image image))) (slime-media-insert-image image string)) t) (t nil))) (defun slime-media-insert-image (image string &optional bol) (with-current-buffer (slime-output-buffer) (let ((marker (slime-output-target-marker :repl-result))) (goto-char marker) (slime-propertize-region `(face slime-repl-result-face rear-nonsticky (face)) (insert-image image string)) ;; Move the input-start marker after the REPL result. (set-marker marker (point))) (slime-repl-show-maximum-output))) (provide 'slime-media) --- /project/slime/cvsroot/slime/contrib/swank-media.lisp 2010/09/16 13:24:20 NONE +++ /project/slime/cvsroot/slime/contrib/swank-media.lisp 2010/09/16 13:24:20 1.1 ;;; swank-media.lisp --- insert other media (images) ;; ;; Authors: Christophe Rhodes ;; ;; Licence: GPLv2 or later ;; (in-package :swank) ;; this file is empty of functionality. The slime-media contrib ;; allows swank to return messages other than :write-string as repl ;; results; this is used in the R implementation of swank to display R ;; objects with graphical representations (such as trellis objects) as ;; image presentations in the swank repl. In R, this is done by ;; having a hook function for the preparation of the repl results, in ;; addition to the already-existing hook for sending the repl results ;; (*send-repl-results-function*, used by swank-presentations.lisp). ;; The swank-media.R contrib implementation defines a generic function ;; for use as this hook, along with methods for commonly-encountered ;; graphical R objects. (This strategy is harder in CL, where methods ;; can only be defined if their specializers already exist; in R's S3 ;; object system, methods are ordinary functions with a special naming ;; convention) From sboukarev at common-lisp.net Thu Sep 16 19:19:26 2010 From: sboukarev at common-lisp.net (CVS User sboukarev) Date: Thu, 16 Sep 2010 15:19:26 -0400 Subject: [slime-cvs] CVS slime/contrib Message-ID: Update of /project/slime/cvsroot/slime/contrib In directory cl-net:/tmp/cvs-serv24864 Modified Files: ChangeLog swank-arglists.lisp Log Message: * swank-arglists.lisp (print-variable-to-string): Use without-printing-errors when printing the value. Reported by Tobias C. Rittweiler on lp#628945. --- /project/slime/cvsroot/slime/contrib/ChangeLog 2010/09/16 13:24:20 1.417 +++ /project/slime/cvsroot/slime/contrib/ChangeLog 2010/09/16 19:19:26 1.418 @@ -1,3 +1,9 @@ +2010-09-16 Stas Boukarev + + * swank-arglists.lisp (print-variable-to-string): Use + without-printing-errors when printing the value. + Reported by Tobias C. Rittweiler on lp#628945. + 2010-09-16 Christophe Rhodes Image display support for the REPL. --- /project/slime/cvsroot/slime/contrib/swank-arglists.lisp 2010/07/23 01:46:34 1.68 +++ /project/slime/cvsroot/slime/contrib/swank-arglists.lisp 2010/09/16 19:19:26 1.69 @@ -1128,10 +1128,12 @@ "Return a short description of VARIABLE-NAME, or NIL." (let ((*print-pretty* t) (*print-level* 4) (*print-length* 10) (*print-lines* 1) - (*print-readably* nil)) + (*print-readably* nil) + (value (symbol-value symbol))) (call/truncated-output-to-string 75 (lambda (s) - (format s "~A => ~S" symbol (symbol-value symbol)))))) + (without-printing-errors (:object value :stream s) + (format s "~A ~A~S" symbol *echo-area-prefix* value)))))) (defslimefun complete-form (raw-form) From sboukarev at common-lisp.net Fri Sep 17 20:32:55 2010 From: sboukarev at common-lisp.net (CVS User sboukarev) Date: Fri, 17 Sep 2010 16:32:55 -0400 Subject: [slime-cvs] CVS slime/contrib Message-ID: Update of /project/slime/cvsroot/slime/contrib In directory cl-net:/tmp/cvs-serv6684 Modified Files: ChangeLog swank-sprof.lisp Log Message: * swank-sprof.lisp (filter-swank-nodes): Filter other swank packages too, not only SWANK. --- /project/slime/cvsroot/slime/contrib/ChangeLog 2010/09/16 19:19:26 1.418 +++ /project/slime/cvsroot/slime/contrib/ChangeLog 2010/09/17 20:32:55 1.419 @@ -1,3 +1,8 @@ +2010-09-17 Stas Boukarev + + * swank-sprof.lisp (filter-swank-nodes): Filter other swank + packages too, not only SWANK. + 2010-09-16 Stas Boukarev * swank-arglists.lisp (print-variable-to-string): Use --- /project/slime/cvsroot/slime/contrib/swank-sprof.lisp 2010/07/24 20:40:55 1.4 +++ /project/slime/cvsroot/slime/contrib/swank-sprof.lisp 2010/09/17 20:32:55 1.5 @@ -39,12 +39,15 @@ (samples-percent (sb-sprof::node-accrued-count node)))) (defun filter-swank-nodes (nodes) - (let ((swank-package (find-package :swank))) + (let ((swank-packages (load-time-value + (mapcar #'find-package + '(swank swank-rpc swank-mop + swank-match swank-backend))))) (remove-if (lambda (node) (let ((name (sb-sprof::node-name node))) (and (symbolp name) - (eql (symbol-package name) - swank-package)))) + (member (symbol-package name) swank-packages + :test #'eq)))) nodes))) (defun serialize-call-graph (&key exclude-swank) From trittweiler at common-lisp.net Sat Sep 18 08:54:02 2010 From: trittweiler at common-lisp.net (CVS User trittweiler) Date: Sat, 18 Sep 2010 04:54:02 -0400 Subject: [slime-cvs] CVS slime Message-ID: Update of /project/slime/cvsroot/slime In directory cl-net:/tmp/cvs-serv18113 Modified Files: ChangeLog slime.el swank.lisp Log Message: Make C-c C-m also expand compiler macros. (lp#638720) * slime.el (slime-macro/compiler-macro-expand-1): New. (slime-macro/compiler-macro-expand-1-inplace): New. (slime-editing-keys): Map `C-c C-m' to first above. (slime-compiler-macroexpand-1): Take prefix-arg like others. (slime-compiler-macroexpand-1-inplace): Ditto. (slime-compiler-macroexpand): Thus deleted. (slime-compiler-macroexpand-inplace): Ditto. * swank.lisp (swank-macro/compiler-macro-expand-1): New interface. (swank-macro/compiler-macro-expand): New interface. (macro/compiler-macro-expand-1): New. (macro/compiler-macro-expand): New. (expand-repeatedly): New helper. --- /project/slime/cvsroot/slime/ChangeLog 2010/09/03 22:29:43 1.2138 +++ /project/slime/cvsroot/slime/ChangeLog 2010/09/18 08:54:01 1.2139 @@ -1,3 +1,21 @@ +2010-09-18 Tobias C. Rittweiler + + Make C-c C-m also expand compiler macros. (lp#638720) + + * slime.el (slime-macro/compiler-macro-expand-1): New. + (slime-macro/compiler-macro-expand-1-inplace): New. + (slime-editing-keys): Map `C-c C-m' to first above. + (slime-compiler-macroexpand-1): Take prefix-arg like others. + (slime-compiler-macroexpand-1-inplace): Ditto. + (slime-compiler-macroexpand): Thus deleted. + (slime-compiler-macroexpand-inplace): Ditto. + + * swank.lisp (swank-macro/compiler-macro-expand-1): New interface. + (swank-macro/compiler-macro-expand): New interface. + (macro/compiler-macro-expand-1): New. + (macro/compiler-macro-expand): New. + (expand-repeatedly): New helper. + 2010-09-03 Stas Boukarev * slime.el (slime-forward-cruft): Use " \t\n" to match whitespaces --- /project/slime/cvsroot/slime/slime.el 2010/09/03 22:29:43 1.1338 +++ /project/slime/cvsroot/slime/slime.el 2010/09/18 08:54:01 1.1339 @@ -550,7 +550,7 @@ ;;("\C-x\M-e" slime-eval-last-expression-display-output :inferior t) ("\C-c\C-p" slime-pprint-eval-last-expression) ;; Macroexpand - ("\C-c\C-m" slime-macroexpand-1) + ("\C-c\C-m" slime-macro/compiler-macro-expand-1) ("\C-c\M-m" slime-macroexpand-all) ;; Misc ("\C-c\C-u" slime-undefine-function) @@ -4879,7 +4879,8 @@ (remap 'slime-macroexpand-1 'slime-macroexpand-1-inplace) (remap 'slime-macroexpand-all 'slime-macroexpand-all-inplace) (remap 'slime-compiler-macroexpand-1 'slime-compiler-macroexpand-1-inplace) - (remap 'slime-compiler-macroexpand 'slime-compiler-macroexpand-inplace) + (remap 'slime-macro/compiler-macro-expand-1 + 'slime-macro/compiler-macro-expand-1-inplace) (remap 'advertised-undo 'slime-macroexpand-undo) (remap 'undo 'slime-macroexpand-undo)) @@ -5002,25 +5003,41 @@ (interactive) (slime-eval-macroexpand-inplace 'swank:swank-macroexpand-all)) -(defun slime-compiler-macroexpand () +(defun slime-compiler-macroexpand-1 (&optional repeatedly) "Display the compiler-macro expansion of sexp at point." - (interactive) - (slime-eval-macroexpand 'swank:swank-compiler-macroexpand)) + (interactive "P") + (slime-eval-macroexpand + (if repeatedly + 'swank:swank-compiler-macroexpand + 'swank:swank-compiler-macroexpand-1))) -(defun slime-compiler-macroexpand-inplace () +(defun slime-compiler-macroexpand-1-inplace (&optional repeatedly) "Display the compiler-macro expansion of sexp at point." - (interactive) - (slime-eval-macroexpand-inplace 'swank:swank-compiler-macroexpand)) + (interactive "P") + (slime-eval-macroexpand-inplace + (if repeatedly + 'swank:swank-compiler-macroexpand + 'swank:swank-compiler-macroexpand-1))) -(defun slime-compiler-macroexpand-1 () - "Display the compiler-macro expansion of sexp at point." - (interactive) - (slime-eval-macroexpand 'swank:swank-compiler-macroexpand-1)) +(defun slime-macro/compiler-macro-expand-1 (&optional repeatedly) + "Display the macro expansion of the form at point. +The form is expanded with CL:MACROEXPAND-1 or, if a prefix +argument is given, with CL:MACROEXPAND." + (interactive "P") + (slime-eval-macroexpand + (if repeatedly + 'swank:swank-macro/compiler-macro-expand + 'swank:swank-macro/compiler-macro-expand-1))) -(defun slime-compiler-macroexpand-1-inplace () - "Display the compiler-macro expansion of sexp at point." - (interactive) - (slime-eval-macroexpand-inplace 'swank:swank-compiler-macroexpand-1)) +(defun slime-macro/compiler-macro-expand-1-inplace (&optional repeatedly) + "Display the macro expansion of the form at point. +The form is expanded with CL:MACROEXPAND-1 or, if a prefix +argument is given, with CL:MACROEXPAND." + (interactive "P") + (slime-eval-macroexpand-inplace + (if repeatedly + 'swank:swank-macro/compiler-macro-expand + 'swank:swank-macro/compiler-macro-expand-1))) (defun slime-format-string-expand () "Expand the format-string at point and display it." --- /project/slime/cvsroot/slime/swank.lisp 2010/09/03 07:25:19 1.726 +++ /project/slime/cvsroot/slime/swank.lisp 2010/09/18 08:54:01 1.727 @@ -2974,6 +2974,27 @@ (defslimefun swank-compiler-macroexpand (string) (apply-macro-expander #'compiler-macroexpand string)) +(defslimefun swank-macro/compiler-macro-expand-1 (string) + (apply-macro-expander #'macro/compiler-macro-expand-1 string)) + +(defslimefun swank-macro/compiler-macro-expand (string) + (apply-macro-expander #'macro/compiler-macro-expand string)) + +(defun macro/compiler-macro-expand-1 (form) + (multiple-value-bind (expansion expanded?) (macroexpand-1 form) + (if expanded? + (values expansion t) + (compiler-macroexpand-1 form)))) + +(defun macro/compiler-macro-expand (form) + (expand-repeatedly #'macro/compiler-macro-expand-1 form)) + +(defun expand-repeatedly (expander form) + (loop + (multiple-value-bind (expansion expanded?) (funcall expander form) + (unless expanded? (return expansion)) + (setq form expansion)))) + (defslimefun swank-format-string-expand (string) (apply-macro-expander #'format-string-expand string)) From trittweiler at common-lisp.net Sat Sep 18 09:01:39 2010 From: trittweiler at common-lisp.net (CVS User trittweiler) Date: Sat, 18 Sep 2010 05:01:39 -0400 Subject: [slime-cvs] CVS slime Message-ID: Update of /project/slime/cvsroot/slime In directory cl-net:/tmp/cvs-serv21645 Modified Files: ChangeLog swank.lisp Log Message: * swank.lisp (before-init): push :SWANK to *FEATURES*. (lp#627313) --- /project/slime/cvsroot/slime/ChangeLog 2010/09/18 08:54:01 1.2139 +++ /project/slime/cvsroot/slime/ChangeLog 2010/09/18 09:01:39 1.2140 @@ -1,5 +1,9 @@ 2010-09-18 Tobias C. Rittweiler + * swank.lisp (before-init): push :SWANK to *FEATURES*. (lp#627313) + +2010-09-18 Tobias C. Rittweiler + Make C-c C-m also expand compiler macros. (lp#638720) * slime.el (slime-macro/compiler-macro-expand-1): New. --- /project/slime/cvsroot/slime/swank.lisp 2010/09/18 08:54:01 1.727 +++ /project/slime/cvsroot/slime/swank.lisp 2010/09/18 09:01:39 1.728 @@ -3962,6 +3962,7 @@ (add-hook *pre-reply-hook* 'sync-indentation-to-emacs) (defun before-init (version load-path) + (pushnew :swank *features*) (setq *swank-wire-protocol-version* version) (setq *load-path* load-path) (swank-backend::warn-unimplemented-interfaces)) From trittweiler at common-lisp.net Sat Sep 18 09:34:06 2010 From: trittweiler at common-lisp.net (CVS User trittweiler) Date: Sat, 18 Sep 2010 05:34:06 -0400 Subject: [slime-cvs] CVS slime Message-ID: Update of /project/slime/cvsroot/slime In directory cl-net:/tmp/cvs-serv28015 Modified Files: ChangeLog swank-backend.lisp Log Message: * swank-backend.lisp (valid-function-name-p): New interface. (compiler-macroexpand-1): Use it to guard against type errors from COMPILER-MACRO-FUNCTION. * swank-arglist.lisp (function-exists-p): Renamed from FUNCTION-EXISTS-P. Uses new SWANK-BACKEND:VALID-FUNCTION-NAME-P underneath. (valid-operator-name-p): Unused, hence deleted. (boundp-and-interesting): Renamed from INTERESTING-VARIABLE-P. --- /project/slime/cvsroot/slime/ChangeLog 2010/09/18 09:01:39 1.2140 +++ /project/slime/cvsroot/slime/ChangeLog 2010/09/18 09:34:05 1.2141 @@ -1,5 +1,11 @@ 2010-09-18 Tobias C. Rittweiler + * swank-backend.lisp (valid-function-name-p): New interface. + (compiler-macroexpand-1): Use it to guard against type errors + from COMPILER-MACRO-FUNCTION. + +2010-09-18 Tobias C. Rittweiler + * swank.lisp (before-init): push :SWANK to *FEATURES*. (lp#627313) 2010-09-18 Tobias C. Rittweiler @@ -14,8 +20,8 @@ (slime-compiler-macroexpand): Thus deleted. (slime-compiler-macroexpand-inplace): Ditto. - * swank.lisp (swank-macro/compiler-macro-expand-1): New interface. - (swank-macro/compiler-macro-expand): New interface. + * swank.lisp (swank-macro/compiler-macro-expand-1): New defslimefun. + (swank-macro/compiler-macro-expand): New defslimefun. (macro/compiler-macro-expand-1): New. (macro/compiler-macro-expand): New. (expand-repeatedly): New helper. --- /project/slime/cvsroot/slime/swank-backend.lisp 2010/08/21 06:39:59 1.200 +++ /project/slime/cvsroot/slime/swank-backend.lisp 2010/09/18 09:34:05 1.201 @@ -603,6 +603,15 @@ (declare (ignore function)) nil) +(definterface valid-function-name-p (form) + "Is FORM syntactically valid to name a function? + If true, FBOUNDP should not signal a type-error for FORM." + (flet ((length=2 (list) + (and (not (null (cdr list))) (null (cddr list))))) + (or (symbolp form) + (and (consp form) (length=2 form) + (eq (first form) 'setf) (symbolp (second form)))))) + (definterface macroexpand-all (form) "Recursively expand all macros in FORM. Return the resulting form.") @@ -613,7 +622,9 @@ defined, invoke the expander function using *macroexpand-hook* and return the results and T. Otherwise, return the original form and NIL." - (let ((fun (and (consp form) (compiler-macro-function (car form))))) + (let ((fun (and (consp form) + (valid-function-name-p (car form)) + (compiler-macro-function (car form))))) (if fun (let ((result (funcall *macroexpand-hook* fun form env))) (values result (not (eq result form)))) From trittweiler at common-lisp.net Sat Sep 18 09:34:06 2010 From: trittweiler at common-lisp.net (CVS User trittweiler) Date: Sat, 18 Sep 2010 05:34:06 -0400 Subject: [slime-cvs] CVS slime/contrib Message-ID: Update of /project/slime/cvsroot/slime/contrib In directory cl-net:/tmp/cvs-serv28015/contrib Modified Files: ChangeLog swank-arglists.lisp Log Message: * swank-backend.lisp (valid-function-name-p): New interface. (compiler-macroexpand-1): Use it to guard against type errors from COMPILER-MACRO-FUNCTION. * swank-arglist.lisp (function-exists-p): Renamed from FUNCTION-EXISTS-P. Uses new SWANK-BACKEND:VALID-FUNCTION-NAME-P underneath. (valid-operator-name-p): Unused, hence deleted. (boundp-and-interesting): Renamed from INTERESTING-VARIABLE-P. --- /project/slime/cvsroot/slime/contrib/ChangeLog 2010/09/17 20:32:55 1.419 +++ /project/slime/cvsroot/slime/contrib/ChangeLog 2010/09/18 09:34:06 1.420 @@ -1,3 +1,11 @@ +2010-09-18 Tobias C. Rittweiler + + * swank-arglist.lisp (function-exists-p): Renamed from + FUNCTION-EXISTS-P. Uses new SWANK-BACKEND:VALID-FUNCTION-NAME-P + underneath. + (valid-operator-name-p): Unused, hence deleted. + (boundp-and-interesting): Renamed from INTERESTING-VARIABLE-P. + 2010-09-17 Stas Boukarev * swank-sprof.lisp (filter-swank-nodes): Filter other swank --- /project/slime/cvsroot/slime/contrib/swank-arglists.lisp 2010/09/16 19:19:26 1.69 +++ /project/slime/cvsroot/slime/contrib/swank-arglists.lisp 2010/09/18 09:34:06 1.70 @@ -51,26 +51,11 @@ (special-operator-p symbol) (member symbol '(declare declaim)))) -(defun valid-operator-name-p (string) - "Is STRING the name of a function, macro, or special-operator?" - (let ((symbol (parse-symbol string))) - (valid-operator-symbol-p symbol))) - -(defun valid-function-name-p (form) - (and (match form - ((#'symbolp _) t) - (('setf (#'symbolp _)) t) - (_ nil)) +(defun function-exists-p (form) + (and (valid-function-name-p form) (fboundp form) t)) -(defun interesting-variable-p (symbol) - (and symbol - (symbolp symbol) - (boundp symbol) - (not (memq symbol '(cl:t cl:nil))) - (not (keywordp symbol)))) - (defmacro multiple-value-or (&rest forms) (if (null forms) nil @@ -980,7 +965,7 @@ (defmethod arglist-dispatch ((operator (eql 'defmethod)) arguments) (match (cons operator arguments) - (('defmethod (#'valid-function-name-p gf-name) . rest) + (('defmethod (#'function-exists-p gf-name) . rest) (let ((gf (fdefinition gf-name))) (when (typep gf 'generic-function) (with-available-arglist (arglist) (decode-arglist (arglist gf)) @@ -996,7 +981,7 @@ (defmethod arglist-dispatch ((operator (eql 'define-compiler-macro)) arguments) (match (cons operator arguments) - (('define-compiler-macro (#'valid-function-name-p gf-name) . _) + (('define-compiler-macro (#'function-exists-p gf-name) . _) (let ((gf (fdefinition gf-name))) (with-available-arglist (arglist) (decode-arglist (arglist gf)) (return-from arglist-dispatch @@ -1112,7 +1097,7 @@ (with-buffer-syntax () (multiple-value-bind (form arglist obj-at-cursor form-path) (find-subform-with-arglist (parse-raw-form raw-form)) - (cond ((interesting-variable-p obj-at-cursor) + (cond ((boundp-and-interesting obj-at-cursor) (print-variable-to-string obj-at-cursor)) (t (with-available-arglist (arglist) arglist @@ -1124,6 +1109,13 @@ form arglist))))))))) +(defun boundp-and-interesting (symbol) + (and symbol + (symbolp symbol) + (boundp symbol) + (not (memq symbol '(cl:t cl:nil))) + (not (keywordp symbol)))) + (defun print-variable-to-string (symbol) "Return a short description of VARIABLE-NAME, or NIL." (let ((*print-pretty* t) (*print-level* 4) From trittweiler at common-lisp.net Sat Sep 18 20:47:30 2010 From: trittweiler at common-lisp.net (CVS User trittweiler) Date: Sat, 18 Sep 2010 16:47:30 -0400 Subject: [slime-cvs] CVS slime/contrib Message-ID: Update of /project/slime/cvsroot/slime/contrib In directory cl-net:/tmp/cvs-serv18584/contrib Modified Files: ChangeLog slime-autodoc.el slime-parse.el Log Message: * slime-parse.el (slime-parse-form-upto-point): Fix lp#627308. * slime-autodoc.el (slime-canonicalize-whitespace): New helper. Extracted out of `slime-format-autodoc'. (slime-autodoc-to-string): New helper. (slime-check-autodoc-at-point): Use it. (autodoc.1): Add test case for above fix. --- /project/slime/cvsroot/slime/contrib/ChangeLog 2010/09/18 09:34:06 1.420 +++ /project/slime/cvsroot/slime/contrib/ChangeLog 2010/09/18 20:47:29 1.421 @@ -1,5 +1,15 @@ 2010-09-18 Tobias C. Rittweiler + * slime-parse.el (slime-parse-form-upto-point): Fix lp#627308. + + * slime-autodoc.el (slime-canonicalize-whitespace): New + helper. Extracted out of `slime-format-autodoc'. + (slime-autodoc-to-string): New helper. + (slime-check-autodoc-at-point): Use it. + (autodoc.1): Add test case for above fix. + +2010-09-18 Tobias C. Rittweiler + * swank-arglist.lisp (function-exists-p): Renamed from FUNCTION-EXISTS-P. Uses new SWANK-BACKEND:VALID-FUNCTION-NAME-P underneath. --- /project/slime/cvsroot/slime/contrib/slime-autodoc.el 2010/05/13 15:31:07 1.46 +++ /project/slime/cvsroot/slime/contrib/slime-autodoc.el 2010/09/18 20:47:29 1.47 @@ -111,11 +111,14 @@ ;;;; Formatting autodoc +(defsubst slime-canonicalize-whitespace (string) + (replace-regexp-in-string "[ \n\t]+" " " string)) + (defun slime-format-autodoc (doc multilinep) (let ((doc (slime-fontify-string doc))) (if multilinep doc - (slime-oneliner (replace-regexp-in-string "[ \n\t]+" " " doc))))) + (slime-oneliner (slime-canonicalize-whitespace doc))))) (defun slime-fontify-string (string) "Fontify STRING as `font-lock-mode' does in Lisp mode." @@ -238,13 +241,19 @@ ;;;; Test cases +(defun slime-autodoc-to-string () + "Retrieve and return autodoc for form at point." + (let ((autodoc (slime-eval (second (slime-make-autodoc-rpc-form))))) + (if (eq autodoc :not-available) + :not-available + (slime-canonicalize-whitespace autodoc)))) + (defun slime-check-autodoc-at-point (arglist) - (let ((slime-autodoc-use-multiline-p nil)) - (slime-test-expect (format "Autodoc in `%s' (at %d) is as expected" - (buffer-string) (point)) - arglist - (slime-eval (second (slime-make-autodoc-rpc-form))) - 'equal))) + (slime-test-expect (format "Autodoc in `%s' (at %d) is as expected" + (buffer-string) (point)) + arglist + (slime-autodoc-to-string) + 'equal)) (def-slime-test autodoc.1 (buffer-sexpr wished-arglist &optional skip-trailing-test-p) @@ -310,6 +319,8 @@ ;; Test &KEY and nested arglists ("(swank::with-retry-restart (:msg *HERE*" "(with-retry-restart (&key ===> (msg \"Retry.\") <===) &body body)") + ("(swank::with-retry-restart (:msg *HERE*(foo" + "(with-retry-restart (&key ===> (msg \"Retry.\") <===) &body body)" t) ("(swank::start-server \"/tmp/foo\" :coding-system *HERE*" "(start-server port-file &key (style swank:*communication-style*) (dont-close swank:*dont-close*) ===> (coding-system swank::*coding-system*) <===)") --- /project/slime/cvsroot/slime/contrib/slime-parse.el 2010/06/18 12:31:55 1.38 +++ /project/slime/cvsroot/slime/contrib/slime-parse.el 2010/09/18 20:47:29 1.39 @@ -83,12 +83,15 @@ (cond ((slime-compare-char-syntax #'char-after "(" t) ;; We're at the start of some expression, so make sure ;; that SWANK::%CURSOR-MARKER% will come after that - ;; expression. - (ignore-errors (forward-sexp))) + ;; expression. If the expression is not balanced, make + ;; still sure that the marker does *not* come directly + ;; after the preceding expression. + (or (ignore-errors (forward-sexp) t) + (push "" suffix))) ((or (bolp) (slime-compare-char-syntax #'char-before " " t)) ;; We're after some expression, so we have to make sure - ;; that %CURSOR-MARKER% does not come directly after that - ;; expression. + ;; that %CURSOR-MARKER% does *not* come directly after + ;; that expression. (push "" suffix)) ((slime-compare-char-syntax #'char-before "(" t) ;; We're directly after an opening parenthesis, so we From sboukarev at common-lisp.net Mon Sep 20 16:09:13 2010 From: sboukarev at common-lisp.net (CVS User sboukarev) Date: Mon, 20 Sep 2010 12:09:13 -0400 Subject: [slime-cvs] CVS slime Message-ID: Update of /project/slime/cvsroot/slime In directory cl-net:/tmp/cvs-serv2270 Modified Files: ChangeLog swank-cmucl.lisp Log Message: * swank-cmucl.lisp (character-completion-set): Implement. Requires recent versions of CMUCL. Patch by Raymond Toy. --- /project/slime/cvsroot/slime/ChangeLog 2010/09/18 09:34:05 1.2141 +++ /project/slime/cvsroot/slime/ChangeLog 2010/09/20 16:09:13 1.2142 @@ -1,3 +1,9 @@ +2010-09-20 Stas Boukarev + + * swank-cmucl.lisp (character-completion-set): Implement. Requires + recent versions of CMUCL. + Patch by Raymond Toy. + 2010-09-18 Tobias C. Rittweiler * swank-backend.lisp (valid-function-name-p): New interface. --- /project/slime/cvsroot/slime/swank-cmucl.lisp 2010/09/02 17:21:09 1.230 +++ /project/slime/cvsroot/slime/swank-cmucl.lisp 2010/09/20 16:09:13 1.231 @@ -2556,3 +2556,23 @@ (call-program args :output t) (delete-file infile) outfile))) + +#+#.(swank-backend:with-symbol 'unicode-complete 'lisp) +(defun match-semi-standard (prefix matchp) + ;; Handle the CMUCL's short character names. + (loop for name in lisp::char-name-alist + when (funcall matchp prefix (car name)) + collect (car name))) + +#+#.(swank-backend:with-symbol 'unicode-complete 'lisp) +(defimplementation character-completion-set (prefix matchp) + (let ((names (lisp::unicode-complete prefix))) + ;; Match prefix against semistandard names. If there's a match, + ;; add it to our list of matches. + (let ((semi-standard (match-semi-standard prefix matchp))) + (when semi-standard + (setf names (append semi-standard names)))) + (setf names (mapcar #'string-capitalize names)) + (loop for n in names + when (funcall matchp prefix n) + collect n))) From sboukarev at common-lisp.net Wed Sep 22 14:53:14 2010 From: sboukarev at common-lisp.net (CVS User sboukarev) Date: Wed, 22 Sep 2010 10:53:14 -0400 Subject: [slime-cvs] CVS slime Message-ID: Update of /project/slime/cvsroot/slime In directory cl-net:/tmp/cvs-serv4843 Modified Files: ChangeLog swank-clisp.lisp Log Message: * swank-clisp.lisp (*external-format-to-coding-system*): Remove stray :latin-1 argument for ext:make-encoding. Reported by Mirko Vukovic. --- /project/slime/cvsroot/slime/ChangeLog 2010/09/20 16:09:13 1.2142 +++ /project/slime/cvsroot/slime/ChangeLog 2010/09/22 14:53:14 1.2143 @@ -1,3 +1,9 @@ +2010-09-22 Stas Boukarev + + * swank-clisp.lisp (*external-format-to-coding-system*): Remove + stray :latin-1 argument for ext:make-encoding. + Reported by Mirko Vukovic. + 2010-09-20 Stas Boukarev * swank-cmucl.lisp (character-completion-set): Implement. Requires --- /project/slime/cvsroot/slime/swank-clisp.lisp 2010/05/06 06:18:32 1.94 +++ /project/slime/cvsroot/slime/swank-clisp.lisp 2010/09/22 14:53:14 1.95 @@ -177,7 +177,7 @@ (defvar *external-format-to-coding-system* '(((:charset "iso-8859-1" :line-terminator :unix) "latin-1-unix" "iso-latin-1-unix" "iso-8859-1-unix") - ((:charset "iso-8859-1":latin-1) + ((:charset "iso-8859-1") "latin-1" "iso-latin-1" "iso-8859-1") ((:charset "utf-8") "utf-8") ((:charset "utf-8" :line-terminator :unix) "utf-8-unix") From sboukarev at common-lisp.net Wed Sep 22 19:17:35 2010 From: sboukarev at common-lisp.net (CVS User sboukarev) Date: Wed, 22 Sep 2010 15:17:35 -0400 Subject: [slime-cvs] CVS slime Message-ID: Update of /project/slime/cvsroot/slime In directory cl-net:/tmp/cvs-serv15670 Modified Files: ChangeLog slime.el swank.lisp Log Message: * swank.lisp (eval-for-emacs): Send (:abort condition) where condition is a condition which was aborted instead of just (:abort). * slime.el: Handle the above change. * contrib/slime-repl.el: Handle (:abort condition) message from lisp. --- /project/slime/cvsroot/slime/ChangeLog 2010/09/22 14:53:14 1.2143 +++ /project/slime/cvsroot/slime/ChangeLog 2010/09/22 19:17:35 1.2144 @@ -1,5 +1,11 @@ 2010-09-22 Stas Boukarev + * swank.lisp (eval-for-emacs): Send (:abort condition) where + condition is a condition which was aborted instead of just (:abort). + * slime.el: Handle the above change. + +2010-09-22 Stas Boukarev + * swank-clisp.lisp (*external-format-to-coding-system*): Remove stray :latin-1 argument for ext:make-encoding. Reported by Mirko Vukovic. --- /project/slime/cvsroot/slime/slime.el 2010/09/18 08:54:01 1.1339 +++ /project/slime/cvsroot/slime/slime.el 2010/09/22 19:17:35 1.1340 @@ -2076,7 +2076,7 @@ CLAUSES is a list of patterns with same syntax as `destructure-case'. The result of the evaluation of SEXP is dispatched on CLAUSES. The result is either a sexp of the -form (:ok VALUE) or (:abort). CLAUSES is executed +form (:ok VALUE) or (:abort CONDITION). CLAUSES is executed asynchronously. Note: don't use backquote syntax for SEXP, because various Emacs @@ -2158,7 +2158,7 @@ (error "Reply to canceled synchronous eval request tag=%S sexp=%S" tag sexp)) (throw tag (list #'identity value))) - ((:abort) + ((:abort condition) (throw tag (list #'error "Synchronous Lisp Evaluation aborted")))) (let ((debug-on-quit t) (inhibit-quit nil) @@ -2176,8 +2176,8 @@ (when cont (set-buffer buffer) (funcall cont result))) - ((:abort) - (message "Evaluation aborted."))) + ((:abort condition) + (message "Evaluation aborted on %s." condition))) ;; Guard against arbitrary return values which once upon a time ;; showed up in the minibuffer spuriously (due to a bug in ;; slime-autodoc.) If this ever happens again, returning the @@ -4082,9 +4082,9 @@ ((:ok value) (run-hooks 'slime-transcript-stop-hook) (slime-display-eval-result value)) - ((:abort) + ((:abort condition) (run-hooks 'slime-transcript-stop-hook) - (message "Evaluation aborted.")))) + (message "Evaluation aborted on %s." condition)))) (defun slime-eval-describe (form) "Evaluate FORM in Lisp and display the result in a new buffer." @@ -5884,7 +5884,7 @@ (assert sldb-restarts () "sldb-quit called outside of sldb buffer") (slime-rex () ('(swank:throw-to-toplevel)) ((:ok x) (error "sldb-quit returned [%s]" x)) - ((:abort)))) + ((:abort _)))) (defun sldb-continue () "Invoke the \"continue\" restart." @@ -5895,7 +5895,7 @@ ((:ok _) (message "No restart named continue") (ding)) - ((:abort)))) + ((:abort _)))) (defun sldb-abort () "Invoke the \"abort\" restart." @@ -5912,7 +5912,7 @@ (slime-rex () ((list 'swank:invoke-nth-restart-for-emacs sldb-level restart)) ((:ok value) (message "Restart returned: %s" value)) - ((:abort))))) + ((:abort _))))) (defun sldb-invoke-restart-by-name (restart-name) (interactive (list (let ((completion-ignore-case t)) @@ -5929,7 +5929,7 @@ ((list 'swank:sldb-break-with-default-debugger (not (not dont-unwind))) nil slime-current-thread) - ((:abort)))) + ((:abort _)))) (defun sldb-break-with-system-debugger (&optional lightweight) "Enter system debugger (gdb)." @@ -6015,7 +6015,7 @@ (slime-rex () ((list 'swank:sldb-return-from-frame number string)) ((:ok value) (message "%s" value)) - ((:abort))))) + ((:abort _))))) (defun sldb-restart-frame () "Causes the frame to restart execution with the same arguments as it @@ -6025,7 +6025,7 @@ (slime-rex () ((list 'swank:restart-frame number)) ((:ok value) (message "%s" value)) - ((:abort))))) + ((:abort _))))) ;;;;;; SLDB recompilation commands --- /project/slime/cvsroot/slime/swank.lisp 2010/09/18 09:01:39 1.728 +++ /project/slime/cvsroot/slime/swank.lisp 2010/09/22 19:17:35 1.729 @@ -2107,7 +2107,7 @@ "Bind *BUFFER-PACKAGE* to BUFFER-PACKAGE and evaluate FORM. Return the result to the continuation ID. Errors are trapped and invoke our debugger." - (let (ok result) + (let (ok result condition) (unwind-protect (let ((*buffer-package* (guess-buffer-package buffer-package)) (*buffer-readtable* (guess-buffer-readtable buffer-package)) @@ -2116,13 +2116,14 @@ (check-type *buffer-readtable* readtable) ;; APPLY would be cleaner than EVAL. ;; (setq result (apply (car form) (cdr form))) - (setq result (with-slime-interrupts (eval form))) + (handler-bind ((t (lambda (c) (setf condition c)))) + (setq result (with-slime-interrupts (eval form)))) (run-hook *pre-reply-hook*) (setq ok t)) (send-to-emacs `(:return ,(current-thread) ,(if ok `(:ok ,result) - `(:abort)) + `(:abort ,(prin1-to-string condition))) ,id))))) (defvar *echo-area-prefix* "=> " From sboukarev at common-lisp.net Wed Sep 22 19:17:35 2010 From: sboukarev at common-lisp.net (CVS User sboukarev) Date: Wed, 22 Sep 2010 15:17:35 -0400 Subject: [slime-cvs] CVS slime/contrib Message-ID: Update of /project/slime/cvsroot/slime/contrib In directory cl-net:/tmp/cvs-serv15670/contrib Modified Files: ChangeLog slime-repl.el Log Message: * swank.lisp (eval-for-emacs): Send (:abort condition) where condition is a condition which was aborted instead of just (:abort). * slime.el: Handle the above change. * contrib/slime-repl.el: Handle (:abort condition) message from lisp. --- /project/slime/cvsroot/slime/contrib/ChangeLog 2010/09/18 20:47:29 1.421 +++ /project/slime/cvsroot/slime/contrib/ChangeLog 2010/09/22 19:17:35 1.422 @@ -1,3 +1,7 @@ +2010-09-22 Stas Boukarev + + * slime-repl.el: Handle (:abort condition) message from lisp. + 2010-09-18 Tobias C. Rittweiler * slime-parse.el (slime-parse-form-upto-point): Fix lp#627308. --- /project/slime/cvsroot/slime/contrib/slime-repl.el 2010/09/03 19:04:28 1.50 +++ /project/slime/cvsroot/slime/contrib/slime-repl.el 2010/09/22 19:17:35 1.51 @@ -524,8 +524,8 @@ ((list 'swank:listener-eval string) (slime-lisp-package)) ((:ok result) (slime-repl-insert-result result)) - ((:abort) - (slime-repl-show-abort)))) + ((:abort condition) + (slime-repl-show-abort condition)))) (defun slime-repl-insert-result (result) (with-current-buffer (slime-output-buffer) @@ -541,13 +541,13 @@ (slime-repl-insert-prompt)) (slime-repl-show-maximum-output))) -(defun slime-repl-show-abort () +(defun slime-repl-show-abort (condition) (with-current-buffer (slime-output-buffer) (save-excursion (slime-save-marker slime-output-start (slime-save-marker slime-output-end (goto-char slime-output-end) - (insert-before-markers "; Evaluation aborted.\n") + (insert-before-markers (format "; Evaluation aborted on %s.\n" condition)) (slime-repl-insert-prompt)))) (slime-repl-show-maximum-output))) From sboukarev at common-lisp.net Sun Sep 26 18:10:33 2010 From: sboukarev at common-lisp.net (CVS User sboukarev) Date: Sun, 26 Sep 2010 14:10:33 -0400 Subject: [slime-cvs] CVS slime/contrib Message-ID: Update of /project/slime/cvsroot/slime/contrib In directory cl-net:/tmp/cvs-serv24593 Modified Files: ChangeLog slime-repl.el Log Message: * slime-repl.el (slime-repl-history-pattern): Match \t too, besides \ and \n. --- /project/slime/cvsroot/slime/contrib/ChangeLog 2010/09/22 19:17:35 1.422 +++ /project/slime/cvsroot/slime/contrib/ChangeLog 2010/09/26 18:10:33 1.423 @@ -1,3 +1,8 @@ +2010-09-26 Stas Boukarev + + * slime-repl.el (slime-repl-history-pattern): Match \t too, + besides \ and \n. + 2010-09-22 Stas Boukarev * slime-repl.el: Handle (:abort condition) message from lisp. --- /project/slime/cvsroot/slime/contrib/slime-repl.el 2010/09/22 19:17:35 1.51 +++ /project/slime/cvsroot/slime/contrib/slime-repl.el 2010/09/26 18:10:33 1.52 @@ -1016,7 +1016,7 @@ (use-current-input (assert (<= slime-repl-input-start-mark (point))) (let ((str (slime-repl-current-input t))) - (cond ((string-match "^[ \n]*$" str) nil) + (cond ((string-match "^[ \t\n]*$" str) nil) (t (concat "^" (regexp-quote str)))))) (t nil))) From jgarcia at common-lisp.net Tue Sep 28 21:46:02 2010 From: jgarcia at common-lisp.net (CVS User jgarcia) Date: Tue, 28 Sep 2010 17:46:02 -0400 Subject: [slime-cvs] CVS slime Message-ID: Update of /project/slime/cvsroot/slime In directory cl-net:/tmp/cvs-serv17844 Modified Files: swank-ecl.lisp Log Message: frame-decode-env did not ignore FLET bindings in bytecodes environments. --- /project/slime/cvsroot/slime/swank-ecl.lisp 2010/03/19 12:32:30 1.66 +++ /project/slime/cvsroot/slime/swank-ecl.lisp 2010/09/28 21:46:02 1.67 @@ -442,7 +442,7 @@ (blocks '()) (variables '())) (setf frame (si::decode-ihs-env (second frame))) - (dolist (record frame) + (dolist (record (remove-if-not #'consp frame)) (let* ((record0 (car record)) (record1 (cdr record))) (cond ((or (symbolp record0) (stringp record0))