From heller at common-lisp.net Fri Oct 1 09:30:34 2010 From: heller at common-lisp.net (CVS User heller) Date: Fri, 01 Oct 2010 05:30:34 -0400 Subject: [slime-cvs] CVS slime Message-ID: Update of /project/slime/cvsroot/slime In directory cl-net:/tmp/cvs-serv21431 Modified Files: ChangeLog slime.el Log Message: Save result in kill ring for M-- C-x C-e. For C-u C-x C-e set mark before inserting. * slime.el (slime-eval-save): New function. (slime-eval-print): Set mark before inserting. (slime-interactive-eval): Use it. --- /project/slime/cvsroot/slime/ChangeLog 2010/09/22 19:17:35 1.2144 +++ /project/slime/cvsroot/slime/ChangeLog 2010/10/01 09:30:34 1.2145 @@ -1,3 +1,12 @@ +2010-10-01 Helmut Eller + + Save result in kill ring for M-- C-x C-e. + For C-u C-x C-e set mark before inserting. + + * slime.el (slime-eval-save): New function. + (slime-eval-print): Set mark before inserting. + (slime-interactive-eval): Use it. + 2010-09-22 Stas Boukarev * swank.lisp (eval-for-emacs): Send (:abort condition) where --- /project/slime/cvsroot/slime/slime.el 2010/09/22 19:17:35 1.1340 +++ /project/slime/cvsroot/slime/slime.el 2010/10/01 09:30:34 1.1341 @@ -4055,26 +4055,22 @@ Note: If a prefix argument is in effect then the result will be inserted in the current buffer." (interactive (list (slime-read-from-minibuffer "Slime Eval: "))) - (cond ((not current-prefix-arg) - (slime-eval-with-transcript `(swank:interactive-eval ,string))) - (t - (slime-eval-print string)))) - -(defun slime-display-eval-result (value) - (slime-message "%s" value)) - -(defun slime-eval-print (string) - "Eval STRING in Lisp; insert any output and the result at point." - (slime-eval-async `(swank:eval-and-grab-output ,string) - (lambda (result) - (destructuring-bind (output value) result - (insert output value))))) + (case current-prefix-arg + ((nil) + (slime-eval-with-transcript `(swank:interactive-eval ,string))) + ((-) + (slime-eval-save string)) + (t + (slime-eval-print string)))) (defvar slime-transcript-start-hook nil "Hook run before start an evalution.") (defvar slime-transcript-stop-hook nil "Hook run after finishing a evalution.") +(defun slime-display-eval-result (value) + (slime-message "%s" value)) + (defun slime-eval-with-transcript (form) "Eval FROM in Lisp. Display output, if any." (run-hooks 'slime-transcript-start-hook) @@ -4085,6 +4081,23 @@ ((:abort condition) (run-hooks 'slime-transcript-stop-hook) (message "Evaluation aborted on %s." condition)))) + +(defun slime-eval-print (string) + "Eval STRING in Lisp; insert any output and the result at point." + (slime-eval-async `(swank:eval-and-grab-output ,string) + (lambda (result) + (destructuring-bind (output value) result + (push-mark) + (insert output value))))) + +(defun slime-eval-save (string) + "Evaluate STRING in Lisp and save the result in the kill ring." + (slime-eval-async `(swank:eval-and-grab-output ,string) + (lambda (result) + (destructuring-bind (output value) result + (let ((string (concat output value))) + (kill-new string) + (message "Evaluation finished; pushed result to kill ring.")))))) (defun slime-eval-describe (form) "Evaluate FORM in Lisp and display the result in a new buffer." From heller at common-lisp.net Fri Oct 1 09:30:43 2010 From: heller at common-lisp.net (CVS User heller) Date: Fri, 01 Oct 2010 05:30:43 -0400 Subject: [slime-cvs] CVS slime Message-ID: Update of /project/slime/cvsroot/slime In directory cl-net:/tmp/cvs-serv21469 Modified Files: ChangeLog slime.el Log Message: Don't use indent-sexp for macroexpanded code. indent-sexp is potentially slow and usually redundant. * slime.el (slime-initialize-macroexpansion-buffer): Don't use indent-sexp. (slime-eval-macroexpand-inplace): Avoid indent-sexp but use slime-insert-indented. --- /project/slime/cvsroot/slime/ChangeLog 2010/10/01 09:30:34 1.2145 +++ /project/slime/cvsroot/slime/ChangeLog 2010/10/01 09:30:43 1.2146 @@ -1,5 +1,15 @@ 2010-10-01 Helmut Eller + Don't use indent-sexp for macroexpanded code. + indent-sexp is potentially slow and usually redundant. + + * slime.el (slime-initialize-macroexpansion-buffer): Don't use + indent-sexp. + (slime-eval-macroexpand-inplace): Avoid indent-sexp but + use slime-insert-indented. + +2010-10-01 Helmut Eller + Save result in kill ring for M-- C-x C-e. For C-u C-x C-e set mark before inserting. --- /project/slime/cvsroot/slime/slime.el 2010/10/01 09:30:34 1.1341 +++ /project/slime/cvsroot/slime/slime.el 2010/10/01 09:30:43 1.1342 @@ -4955,7 +4955,6 @@ (erase-buffer) (insert expansion) (goto-char (point-min)) - (indent-sexp) (font-lock-fontify-buffer))) (defun slime-create-macroexpansion-buffer () @@ -4988,9 +4987,7 @@ (slime-remove-edits (point-min) (point-max))) (goto-char start) (delete-region start end) - (insert expansion) - (goto-char start) - (indent-sexp) + (slime-insert-indented expansion) (goto-char point)))))))) (defun slime-macroexpand-1 (&optional repeatedly) @@ -8065,7 +8062,8 @@ (slime-execute-as-command 'slime-macroexpand-1) (slime-wait-condition "Macroexpansion buffer visible" (lambda () - (slime-buffer-visible-p (slime-buffer-name :macroexpansion))) + (slime-buffer-visible-p + (slime-buffer-name :macroexpansion))) 5) (with-current-buffer (get-buffer (slime-buffer-name :macroexpansion)) (slime-test-expect "Initial macroexpansion is correct" From heller at common-lisp.net Sat Oct 2 11:16:55 2010 From: heller at common-lisp.net (CVS User heller) Date: Sat, 02 Oct 2010 07:16:55 -0400 Subject: [slime-cvs] CVS slime Message-ID: Update of /project/slime/cvsroot/slime In directory cl-net:/tmp/cvs-serv8101 Modified Files: ChangeLog slime.el swank.lisp Log Message: Rename slime-macro/compiler-macro-expand-1 => slime-expand-1 * slime.el (slime-expand-1): Renamed from slime-macro/compiler-macro-expand-1. (slime-expand-1-inplace): Renamed from slime-macro/compiler-macro-expand-1-inplace. * swank.lisp (swank-expand-1): Renamed from swank-macro/compiler-macro-expand-1. (swank-expand): Renamed from swank-macro/compiler-macro-expand. (expand-1): Renamed from macro/compiler-macro-expand-1. (expand): Renamed from macro/compiler-macro-expand. --- /project/slime/cvsroot/slime/ChangeLog 2010/10/01 09:30:43 1.2146 +++ /project/slime/cvsroot/slime/ChangeLog 2010/10/02 11:16:54 1.2147 @@ -1,3 +1,18 @@ +2010-10-02 Helmut Eller + + Rename slime-macro/compiler-macro-expand-1 => slime-expand-1 + + * slime.el (slime-expand-1): Renamed from + slime-macro/compiler-macro-expand-1. + (slime-expand-1-inplace): Renamed from + slime-macro/compiler-macro-expand-1-inplace. + + * swank.lisp (swank-expand-1): Renamed from + swank-macro/compiler-macro-expand-1. + (swank-expand): Renamed from swank-macro/compiler-macro-expand. + (expand-1): Renamed from macro/compiler-macro-expand-1. + (expand): Renamed from macro/compiler-macro-expand. + 2010-10-01 Helmut Eller Don't use indent-sexp for macroexpanded code. --- /project/slime/cvsroot/slime/slime.el 2010/10/01 09:30:43 1.1342 +++ /project/slime/cvsroot/slime/slime.el 2010/10/02 11:16:54 1.1343 @@ -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-macro/compiler-macro-expand-1) + ("\C-c\C-m" slime-expand-1) ("\C-c\M-m" slime-macroexpand-all) ;; Misc ("\C-c\C-u" slime-undefine-function) @@ -4892,8 +4892,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-macro/compiler-macro-expand-1 - 'slime-macro/compiler-macro-expand-1-inplace) + (remap 'slime-expand-1 + 'slime-expand-1-inplace) (remap 'advertised-undo 'slime-macroexpand-undo) (remap 'undo 'slime-macroexpand-undo)) @@ -5029,25 +5029,25 @@ 'swank:swank-compiler-macroexpand 'swank:swank-compiler-macroexpand-1))) -(defun slime-macro/compiler-macro-expand-1 (&optional repeatedly) +(defun slime-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))) + 'swank:swank-expand + 'swank:swank-expand-1))) -(defun slime-macro/compiler-macro-expand-1-inplace (&optional repeatedly) +(defun slime-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))) + 'swank:swank-expand + 'swank:swank-expand-1))) (defun slime-format-string-expand () "Expand the format-string at point and display it." --- /project/slime/cvsroot/slime/swank.lisp 2010/09/22 19:17:35 1.729 +++ /project/slime/cvsroot/slime/swank.lisp 2010/10/02 11:16:54 1.730 @@ -2975,20 +2975,20 @@ (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-expand-1 (string) + (apply-macro-expander #'expand-1 string)) -(defslimefun swank-macro/compiler-macro-expand (string) - (apply-macro-expander #'macro/compiler-macro-expand string)) +(defslimefun swank-expand (string) + (apply-macro-expander #'expand string)) -(defun macro/compiler-macro-expand-1 (form) +(defun 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 (form) + (expand-repeatedly #'expand-1 form)) (defun expand-repeatedly (expander form) (loop From nsiivola at common-lisp.net Thu Oct 7 17:15:07 2010 From: nsiivola at common-lisp.net (CVS User nsiivola) Date: Thu, 07 Oct 2010 13:15:07 -0400 Subject: [slime-cvs] CVS slime Message-ID: Update of /project/slime/cvsroot/slime In directory cl-net:/tmp/cvs-serv19896 Modified Files: ChangeLog swank-sbcl.lisp Log Message: SBCL: null *log-output* when saving core Hanging on to a *log-output* from a previous image is bad on SBCL at least: it is initialized to an FD-STREAM, which cannot be reused from one image to another. Deal with this by using sb-ext:*save-hooks* to clear the stream. --- /project/slime/cvsroot/slime/ChangeLog 2010/10/02 11:16:54 1.2147 +++ /project/slime/cvsroot/slime/ChangeLog 2010/10/07 17:15:07 1.2148 @@ -1,3 +1,13 @@ +2010-10-07 Nikodemus Siivola + + Hanging on to a *log-output* from a previous image is bad on SBCL + at least: it is initialized to an FD-STREAM, which cannot be + reused from one image to another. + + Deal with this by using sb-ext:*save-hooks* to clear the stream. + + * swank-sbcl.lisp (deinit-log-output): New function. + 2010-10-02 Helmut Eller Rename slime-macro/compiler-macro-expand-1 => slime-expand-1 --- /project/slime/cvsroot/slime/swank-sbcl.lisp 2010/09/01 13:18:55 1.277 +++ /project/slime/cvsroot/slime/swank-sbcl.lisp 2010/10/07 17:15:07 1.278 @@ -1657,3 +1657,9 @@ (assert (sb-posix:wifexited status)) (funcall completion-function (zerop (sb-posix:wexitstatus status)))))))))))) + +(defun deinit-log-output () + ;; Can't hang on to an fd-stream from a previous session. + (setf *log-output* nil)) + +(pushnew 'deinit-log-output sb-ext:*save-hooks*) From crhodes at common-lisp.net Fri Oct 8 09:03:25 2010 From: crhodes at common-lisp.net (CVS User crhodes) Date: Fri, 08 Oct 2010 05:03:25 -0400 Subject: [slime-cvs] CVS slime Message-ID: Update of /project/slime/cvsroot/slime In directory cl-net:/tmp/cvs-serv19842 Modified Files: ChangeLog slime.el swank-backend.lisp swank.lisp Log Message: add richer location information to the position arg in compile-string-for-emacs R's source location recording infrastructure works with line/column offsets rather than with character offsets, so to get the right srcrefs associated with some string source we need to communicate line and column information from the source buffer. Unfortunately, only the emacs side can do that -- in principle, the R side has no direct access to the source file at all. This means a protocol change, converting the position argument in swank:compile-string-for-emacs to a list of s in the slime source location grammar. At present, pass in both :position and :line kinds, and have swank:compile-string-for-emacs extract just the :position for passing on to swank-compile-string. --- /project/slime/cvsroot/slime/ChangeLog 2010/10/07 17:15:07 1.2148 +++ /project/slime/cvsroot/slime/ChangeLog 2010/10/08 09:03:24 1.2149 @@ -1,3 +1,19 @@ +2010-10-08 Christophe Rhodes + + Pass more detailed source location information to + swank:compile-string-for-emacs. Motivated by R's source location + needs (where srcrefs are line/column based). + + * slime.el (slime-compile-string): Generate :line location format + from start-offset, passing it through to + swank:compile-file-for-emacs. + (find-definition.2): Use new-style position. + + * swank.lisp (compile-string-for-emacs): Use only the offset from + the position argument. + + * swank-backend.lisp (swank-compile-string): Fix docstring typo. + 2010-10-07 Nikodemus Siivola Hanging on to a *log-output* from a previous image is bad on SBCL --- /project/slime/cvsroot/slime/slime.el 2010/10/02 11:16:54 1.1343 +++ /project/slime/cvsroot/slime/slime.el 2010/10/08 09:03:24 1.1344 @@ -2639,14 +2639,18 @@ (run-with-timer (or timeout 0.2) nil 'delete-overlay overlay))) (defun slime-compile-string (string start-offset) - (slime-eval-async - `(swank:compile-string-for-emacs - ,string - ,(buffer-name) - ,start-offset - ,(if (buffer-file-name) (slime-to-lisp-filename (buffer-file-name))) - ',slime-compilation-policy) - #'slime-compilation-finished)) + (let* ((line (save-excursion + (goto-char start-offset) + (list (line-number-at-pos) (1+ (current-column))))) + (position `((:position ,start-offset) (:line , at line)))) + (slime-eval-async + `(swank:compile-string-for-emacs + ,string + ,(buffer-name) + ',position + ,(if (buffer-file-name) (slime-to-lisp-filename (buffer-file-name))) + ',slime-compilation-policy) + #'slime-compilation-finished))) (defun slime-compilation-finished (result) (with-struct (slime-compilation-result. notes duration successp @@ -7727,7 +7731,7 @@ `(swank:compile-string-for-emacs ,buffer-content ,(buffer-name) - ,0 + '((:position 0) (:line 1 1)) ,nil ,nil)) (let ((bufname (buffer-name))) --- /project/slime/cvsroot/slime/swank-backend.lisp 2010/09/18 09:34:05 1.201 +++ /project/slime/cvsroot/slime/swank-backend.lisp 2010/10/08 09:03:24 1.202 @@ -434,7 +434,7 @@ implementations to compile with optimization qualities of its value. -Should return T on successfull compilation, NIL otherwise. +Should return T on successful compilation, NIL otherwise. ") (definterface swank-compile-file (input-file output-file load-p --- /project/slime/cvsroot/slime/swank.lisp 2010/10/02 11:16:54 1.730 +++ /project/slime/cvsroot/slime/swank.lisp 2010/10/08 09:03:24 1.731 @@ -2853,15 +2853,16 @@ (defslimefun compile-string-for-emacs (string buffer position filename policy) "Compile STRING (exerpted from BUFFER at POSITION). Record compiler notes signalled as `compiler-condition's." - (with-buffer-syntax () - (collect-notes - (lambda () - (let ((*compile-print* t) (*compile-verbose* nil)) - (swank-compile-string string - :buffer buffer - :position position - :filename filename - :policy policy)))))) + (let ((offset (cadr (assoc :position position)))) + (with-buffer-syntax () + (collect-notes + (lambda () + (let ((*compile-print* t) (*compile-verbose* nil)) + (swank-compile-string string + :buffer buffer + :position offset + :filename filename + :policy policy))))))) (defslimefun compile-multiple-strings-for-emacs (strings policy) "Compile STRINGS (exerpted from BUFFER at POSITION). From rtoy at common-lisp.net Sat Oct 9 23:02:33 2010 From: rtoy at common-lisp.net (CVS User rtoy) Date: Sat, 09 Oct 2010 19:02:33 -0400 Subject: [slime-cvs] CVS slime Message-ID: Update of /project/slime/cvsroot/slime In directory cl-net:/tmp/cvs-serv8210 Modified Files: ChangeLog swank-backend.lisp swank-cmucl.lisp swank-rpc.lisp Log Message: Add CODEPOINT-LENGTH function to return the number of codepoints in a string. Needed to make sure that Emacs and Lisp agree on the length of a string. Emacs wants codepoints and some lisps give code units. --- /project/slime/cvsroot/slime/ChangeLog 2010/10/08 09:03:24 1.2149 +++ /project/slime/cvsroot/slime/ChangeLog 2010/10/09 23:02:32 1.2150 @@ -1,3 +1,16 @@ +2010-10-09 Raymond Toy + + * swank-cmucl.lisp (codepoint-length): Implement codepoint-length + to return the number of codepoints in cmucl's utf-16 strings. + + * swank-backend.lisp (:swank-backend): Export codepoint-length. + (codepoint-length): definterface codepoint-length. Default is to + use LENGTH. + + * swank-rpc.lisp (write-message): Call + swank-backend:codepoint-length to get the correct length for + emacs. + 2010-10-08 Christophe Rhodes Pass more detailed source location information to --- /project/slime/cvsroot/slime/swank-backend.lisp 2010/10/08 09:03:24 1.202 +++ /project/slime/cvsroot/slime/swank-backend.lisp 2010/10/09 23:02:33 1.203 @@ -1317,3 +1317,12 @@ "Request saving a heap image to the file FILENAME. RESTART-FUNCTION, if non-nil, should be called when the image is loaded. COMPLETION-FUNCTION, if non-nil, should be called after saving the image.") + +;;; Codepoint length + +(definterface codepoint-length (string) + "Return the number of codepoints in STRING. +With some Lisps, like cmucl, LENGTH returns the number of UTF-16 code +units, but other Lisps return the number of codepoints. The slime +protocol wants string lengths in terms of codepoints." + (length string)) --- /project/slime/cvsroot/slime/swank-cmucl.lisp 2010/09/20 16:09:13 1.231 +++ /project/slime/cvsroot/slime/swank-cmucl.lisp 2010/10/09 23:02:33 1.232 @@ -2576,3 +2576,16 @@ (loop for n in names when (funcall matchp prefix n) collect n))) + +(defimplementation codepoint-length (string) + "Return the number of code points in the string. The string MUST be + a valid UTF-16 string." + (do ((len (length string)) + (index 0 (1+ index)) + (count 0 (1+ count))) + ((>= index len) + count) + (multiple-value-bind (codepoint wide) + (lisp:codepoint string index) + (declare (ignore codepoint)) + (when wide (incf index))))) --- /project/slime/cvsroot/slime/swank-rpc.lisp 2010/04/14 17:51:30 1.6 +++ /project/slime/cvsroot/slime/swank-rpc.lisp 2010/10/09 23:02:33 1.7 @@ -92,7 +92,7 @@ (defun write-message (message package stream) (let* ((string (prin1-to-string-for-emacs message package)) - (length (length string))) + (length (swank-backend:codepoint-length string))) (let ((*print-pretty* nil)) (format stream "~6,'0x" length)) (write-string string stream) From alendvai at common-lisp.net Fri Oct 15 16:09:07 2010 From: alendvai at common-lisp.net (CVS User alendvai) Date: Fri, 15 Oct 2010 12:09:07 -0400 Subject: [slime-cvs] CVS slime/contrib Message-ID: Update of /project/slime/cvsroot/slime/contrib In directory cl-net:/tmp/cvs-serv22560 Modified Files: swank-fuzzy.lisp Log Message: Fuzzy completion: speed up by 2-4 times (on sbcl) --- /project/slime/cvsroot/slime/contrib/swank-fuzzy.lisp 2010/09/04 00:32:14 1.11 +++ /project/slime/cvsroot/slime/contrib/swank-fuzzy.lisp 2010/10/15 16:09:07 1.12 @@ -465,8 +465,9 @@ Once a word has been completely matched, the chunks are pushed onto the special variable *ALL-CHUNKS* and the function returns." - (declare ;(optimize speed) - (fixnum short-index initial-full-index) + (declare (optimize speed) + (type fixnum short-index initial-full-index) + (type list current-chunk) (simple-string short full) (special *all-chunks*)) (flet ((short-cur () @@ -485,10 +486,13 @@ "Collects the current chunk to CHUNKS and prepares for a new chunk." (when current-chunk - (push (list current-chunk-pos - (coerce (reverse current-chunk) 'string)) chunks) - (setf current-chunk nil - current-chunk-pos nil)))) + (let ((current-chunk-as-string (nreverse + (make-array (length current-chunk) + :element-type 'character + :initial-contents current-chunk)))) + (push (list current-chunk-pos current-chunk-as-string) chunks) + (setf current-chunk nil + current-chunk-pos nil))))) ;; If there's an outstanding chunk coming in collect it. Since ;; we're recursively called on skipping an input character, the ;; chunk can't possibly continue on. From alendvai at common-lisp.net Fri Oct 15 16:16:11 2010 From: alendvai at common-lisp.net (CVS User alendvai) Date: Fri, 15 Oct 2010 12:16:11 -0400 Subject: [slime-cvs] CVS slime/contrib Message-ID: Update of /project/slime/cvsroot/slime/contrib In directory cl-net:/tmp/cvs-serv23755 Modified Files: slime-fuzzy.el Log Message: Clean up fuzzy.el's keymap code, drop mimic-key-bindings --- /project/slime/cvsroot/slime/contrib/slime-fuzzy.el 2010/08/21 21:34:12 1.21 +++ /project/slime/cvsroot/slime/contrib/slime-fuzzy.el 2010/10/15 16:16:11 1.22 @@ -72,44 +72,32 @@ ;;;;;;; slime-target-buffer-fuzzy-completions-mode ;; NOTE: this mode has to be able to override key mappings in slime-mode -;; FIXME: clean this up - -(defun slime-mimic-key-bindings (from-keymap to-keymap bindings-or-operation operation) - "Iterate on BINDINGS-OR-OPERATION. If an element is a symbol then -try to look it up (as an operation) in FROM-KEYMAP. Non symbols are taken -as default key bindings when none to be mimiced was found in FROM-KEYMAP. -Set the resulting list of keys in TO-KEYMAP to OPERATION." - (let ((mimic-keys nil) - (direct-keys nil)) - (dolist (key-or-operation bindings-or-operation) - (if (symbolp key-or-operation) - (setf mimic-keys (append mimic-keys (where-is-internal key-or-operation from-keymap nil t))) - (push key-or-operation direct-keys))) - (dolist (key (or mimic-keys direct-keys)) - (define-key to-keymap key operation)))) - (defvar slime-target-buffer-fuzzy-completions-map - (let* ((map (make-sparse-keymap))) - (flet ((remap (keys to) - (slime-mimic-key-bindings global-map map keys to))) - - (remap (list 'keyboard-quit (kbd "C-g")) 'slime-fuzzy-abort) - - (remap (list 'slime-fuzzy-indent-and-complete-symbol - 'slime-indent-and-complete-symbol - (kbd "")) - 'slime-fuzzy-select-or-update-completions) - (remap (list 'previous-line (kbd "")) 'slime-fuzzy-prev) - (remap (list 'next-line (kbd "")) 'slime-fuzzy-next) - (remap (list 'isearch-forward (kbd "C-s")) - (lambda () - (interactive) - (select-window (get-buffer-window (slime-get-fuzzy-buffer))) - (call-interactively 'isearch-forward))) - + (let ((map (make-sparse-keymap))) + (flet ((def (keys command) + (unless (listp keys) + (setq keys (list keys))) + (dolist (key keys) + (define-key map key command)))) + (def `([remap keyboard-quit] + ,(kbd "C-g")) + 'slime-fuzzy-abort) + (def `([remap slime-fuzzy-indent-and-complete-symbol] + [remap slime-indent-and-complete-symbol] + ,(kbd "")) + 'slime-fuzzy-select-or-update-completions) + (def `([remap previous-line] + ,(kbd "")) + 'slime-fuzzy-prev) + (def `([remap next-line] + ,(kbd "")) + 'slime-fuzzy-next) + (def `([remap isearch-forward] + ,(kbd "C-s")) + 'slime-fuzzy-continue-isearch-in-fuzzy-buffer) ;; some unconditional direct bindings - (dolist (key (list (kbd "") (kbd "RET") (kbd "") "(" ")" "[" "]")) - (define-key map key 'slime-fuzzy-select-and-process-event-in-target-buffer))) + (def (list (kbd "") (kbd "RET") (kbd "") "(" ")" "[" "]") + 'slime-fuzzy-select-and-process-event-in-target-buffer)) map) "Keymap for slime-target-buffer-fuzzy-completions-mode. This will override the key bindings in the target buffer temporarily during completion.") @@ -122,6 +110,10 @@ (eq a 'slime-fuzzy-target-buffer-completions-mode)) :key #'car)) +(defun slime-fuzzy-continue-isearch-in-fuzzy-buffer () + (interactive) + (select-window (get-buffer-window (slime-get-fuzzy-buffer))) + (call-interactively 'isearch-forward)) (define-minor-mode slime-fuzzy-target-buffer-completions-mode "This minor mode is intented to override key bindings during fuzzy @@ -183,33 +175,35 @@ (make-overlay (point) (point) nil t nil))) (defvar slime-fuzzy-completions-map - (let* ((map (make-sparse-keymap))) - (flet ((remap (keys to) - (slime-mimic-key-bindings global-map map keys to))) - (remap (list 'keyboard-quit (kbd "C-g")) 'slime-fuzzy-abort) - (define-key map "q" 'slime-fuzzy-abort) - - (remap (list 'previous-line (kbd "")) 'slime-fuzzy-prev) - (remap (list 'next-line (kbd "")) 'slime-fuzzy-next) - - (define-key map "n" 'slime-fuzzy-next) - (define-key map "\M-n" 'slime-fuzzy-next) - - (define-key map "p" 'slime-fuzzy-prev) - (define-key map "\M-p" 'slime-fuzzy-prev) - - (define-key map "\d" 'scroll-down) - - (remap (list 'slime-fuzzy-indent-and-complete-symbol - 'slime-indent-and-complete-symbol - (kbd "")) - 'slime-fuzzy-select) - - (define-key map (kbd "") 'slime-fuzzy-select/mouse)) - - (define-key map (kbd "RET") 'slime-fuzzy-select) - (define-key map (kbd "") 'slime-fuzzy-select) - + (let ((map (make-sparse-keymap))) + (flet ((def (keys command) + (unless (listp keys) + (setq keys (list keys))) + (dolist (key keys) + (define-key map key command)))) + (def `([remap keyboard-quit] + "q" + ,(kbd "C-g")) + 'slime-fuzzy-abort) + (def `([remap previous-line] + "p" + "\M-p" + ,(kbd "")) + 'slime-fuzzy-prev) + (def `([remap next-line] + "n" + "\M-n" + ,(kbd "")) + 'slime-fuzzy-next) + (def "\d" 'scroll-down) + (def `([remap slime-fuzzy-indent-and-complete-symbol] + [remap slime-indent-and-complete-symbol] + ,(kbd "")) + 'slime-fuzzy-select) + (def (kbd "") 'slime-fuzzy-select/mouse) + (def `(,(kbd "RET") + ,(kbd "")) + 'slime-fuzzy-select)) map) "Keymap for slime-fuzzy-completions-mode when in the completion buffer.") From alendvai at common-lisp.net Fri Oct 15 16:21:32 2010 From: alendvai at common-lisp.net (CVS User alendvai) Date: Fri, 15 Oct 2010 12:21:32 -0400 Subject: [slime-cvs] CVS slime Message-ID: Update of /project/slime/cvsroot/slime In directory cl-net:/tmp/cvs-serv26265 Modified Files: slime.el Log Message: Added separate host and port history for slime-connect. --- /project/slime/cvsroot/slime/slime.el 2010/10/08 09:03:24 1.1344 +++ /project/slime/cvsroot/slime/slime.el 2010/10/15 16:21:32 1.1345 @@ -198,6 +198,9 @@ :type 'integer :group 'slime-lisp) +(defvar slime-connect-host-history (list slime-lisp-host)) +(defvar slime-connect-port-history (list (prin1-to-string slime-port))) + (defvar slime-net-valid-coding-systems '((iso-latin-1-unix nil "iso-latin-1-unix") (iso-8859-1-unix nil "iso-latin-1-unix") @@ -1170,9 +1173,12 @@ (defun slime-connect (host port &optional coding-system) "Connect to a running Swank server. Return the connection." - (interactive (list (read-from-minibuffer "Host: " slime-lisp-host) - (read-from-minibuffer "Port: " (format "%d" slime-port) - nil t))) + (interactive (list (read-from-minibuffer + "Host: " (first slime-connect-host-history) + nil nil '(slime-connect-host-history . 1)) + (read-from-minibuffer + "Port: " (first slime-connect-port-history) + nil nil '(slime-connect-port-history . 1)))) (when (and (interactive-p) slime-net-processes (y-or-n-p "Close old connections first? ")) (slime-disconnect-all)) From alendvai at common-lisp.net Fri Oct 15 16:25:50 2010 From: alendvai at common-lisp.net (CVS User alendvai) Date: Fri, 15 Oct 2010 12:25:50 -0400 Subject: [slime-cvs] CVS slime Message-ID: Update of /project/slime/cvsroot/slime In directory cl-net:/tmp/cvs-serv26654 Modified Files: slime.el Log Message: slime-lookup-lisp-implementation has better error reporting and allows using a functionp to generate the arguments --- /project/slime/cvsroot/slime/slime.el 2010/10/15 16:21:32 1.1345 +++ /project/slime/cvsroot/slime/slime.el 2010/10/15 16:25:50 1.1346 @@ -1129,8 +1129,14 @@ (list :program program :program-args args)))))) (defun slime-lookup-lisp-implementation (table name) - (destructuring-bind (name (prog &rest args) &rest keys) (assoc name table) - (list* :name name :program prog :program-args args keys))) + (let ((arguments (rest (assoc name table)))) + (unless arguments + (error "Could not find lisp implementation with the name '%S'" name)) + (when (and (= (length arguments) 1) + (functionp (first arguments))) + (setf arguments (funcall (first arguments)))) + (destructuring-bind ((prog &rest args) &rest keys) arguments + (list* :name name :program prog :program-args args keys)))) (defun* slime-start (&key (program inferior-lisp-program) program-args directory From alendvai at common-lisp.net Fri Oct 15 22:42:14 2010 From: alendvai at common-lisp.net (CVS User alendvai) Date: Fri, 15 Oct 2010 18:42:14 -0400 Subject: [slime-cvs] CVS slime/contrib Message-ID: Update of /project/slime/cvsroot/slime/contrib In directory cl-net:/tmp/cvs-serv27538/contrib Modified Files: slime-presentations.el Log Message: Smarten up the label-value-line macros. - support a :label emacs font property - added key args: padding-length, display-nil-value, hide-when-nil, splice-as-ispec, value-text - label-value-line* will evaluate and splice the result of the form after a @ character --- /project/slime/cvsroot/slime/contrib/slime-presentations.el 2010/07/28 15:28:21 1.37 +++ /project/slime/cvsroot/slime/contrib/slime-presentations.el 2010/10/15 22:42:14 1.38 @@ -830,6 +830,8 @@ 'mouse-face 'highlight 'face 'slime-inspector-value-face) (slime-insert-presentation string `(:inspected-part ,id) t))) + ((:label string) + (insert (slime-inspector-fontify label string))) ((:action string id) (slime-insert-propertized (list 'slime-action-number id 'mouse-face 'highlight From alendvai at common-lisp.net Fri Oct 15 22:42:14 2010 From: alendvai at common-lisp.net (CVS User alendvai) Date: Fri, 15 Oct 2010 18:42:14 -0400 Subject: [slime-cvs] CVS slime Message-ID: Update of /project/slime/cvsroot/slime In directory cl-net:/tmp/cvs-serv27538 Modified Files: ChangeLog slime.el swank-backend.lisp swank.lisp Log Message: Smarten up the label-value-line macros. - support a :label emacs font property - added key args: padding-length, display-nil-value, hide-when-nil, splice-as-ispec, value-text - label-value-line* will evaluate and splice the result of the form after a @ character --- /project/slime/cvsroot/slime/ChangeLog 2010/10/09 23:02:32 1.2150 +++ /project/slime/cvsroot/slime/ChangeLog 2010/10/15 22:42:14 1.2151 @@ -1,3 +1,22 @@ +2010-10-16 Attila Lendvai + + * swank-fuzzy.lisp: speed up by 2-4 times (on sbcl). + + * fuzzy.el: Clean up fuzzy completion's keymap code, drop + mimic-key-bindings. + + * slime.el: Added separate host and port history for + slime-connect. + (slime-lookup-lisp-implementation): better error reporting and + allow using a functionp to generate the arguments. + + * swank.lisp: Smarten up the label-value-line macros: + - support a :label emacs font property + - added key args: padding-length, display-nil-value, + hide-when-nil, splice-as-ispec, value-text + - label-value-line* will evaluate and splice the result + of the form after a @ character + 2010-10-09 Raymond Toy * swank-cmucl.lisp (codepoint-length): Implement codepoint-length --- /project/slime/cvsroot/slime/slime.el 2010/10/15 16:25:50 1.1346 +++ /project/slime/cvsroot/slime/slime.el 2010/10/15 22:42:14 1.1347 @@ -6463,6 +6463,8 @@ 'mouse-face 'highlight 'face 'slime-inspector-value-face) (insert string))) + ((:label string) + (insert (slime-inspector-fontify label string))) ((:action string id) (slime-insert-propertized (list 'slime-action-number id 'mouse-face 'highlight --- /project/slime/cvsroot/slime/swank-backend.lisp 2010/10/09 23:02:33 1.203 +++ /project/slime/cvsroot/slime/swank-backend.lisp 2010/10/15 22:42:14 1.204 @@ -1053,17 +1053,45 @@ ;;; Utilities for inspector methods. ;;; - -(defun label-value-line (label value &key (newline t)) - "Create a control list which prints \"LABEL: VALUE\" in the inspector. -If NEWLINE is non-NIL a `(:newline)' is added to the result." - - (list* (princ-to-string label) ": " `(:value ,value) - (if newline '((:newline)) nil))) +(defun label-value-line (label value &key padding-length display-nil-value hide-when-nil + splice-as-ispec value-text (newline t)) + "Create a control list which prints \"LABEL: VALUE\" in the inspector." + (if (or value (not hide-when-nil)) + `((:label ,(princ-to-string label) ":") + ,@(when (or value display-nil-value) + (list " ")) + ,@(when (and (or value display-nil-value) + padding-length) + (list (make-array padding-length + :element-type 'character + :initial-element #\Space))) + ,@(when (or value display-nil-value) + (if splice-as-ispec + (if (listp value) value (list value)) + `((:value ,value ,@(when value-text (list value-text)))))) + ,@(if newline '((:newline)) nil)) + (values))) (defmacro label-value-line* (&rest label-values) - ` (append ,@(loop for (label value) in label-values - collect `(label-value-line ,label ,value)))) + (let ((longest-label-length (loop + :for (label value) :in label-values + :maximize (if (stringp label) + (length label) + 0)))) + `(append ,@(loop + :for entry :in label-values + :if (and (consp entry) + (not (consp (first entry))) + (string= (first entry) '@)) + :appending (rest entry) + :else + :collect (destructuring-bind + (label value &rest args &key &allow-other-keys) entry + `(label-value-line ,label ,value + :padding-length ,(when (stringp label) + (- longest-label-length + (length label))) + , at args)))))) (definterface describe-primitive-type (object) "Return a string describing the primitive type of object." --- /project/slime/cvsroot/slime/swank.lisp 2010/10/08 09:03:24 1.731 +++ /project/slime/cvsroot/slime/swank.lisp 2010/10/15 22:42:14 1.732 @@ -3479,6 +3479,8 @@ ((:newline) (list newline)) ((:value obj &optional str) (list (value-part obj str (istate.parts istate)))) + ((:label &rest strs) + (list (list :label (apply #'concatenate 'string (mapcar #'string strs))))) ((:action label lambda &key (refreshp t)) (list (action-part label lambda refreshp (istate.actions istate)))) From alendvai at common-lisp.net Fri Oct 15 22:53:45 2010 From: alendvai at common-lisp.net (CVS User alendvai) Date: Fri, 15 Oct 2010 18:53:45 -0400 Subject: [slime-cvs] CVS slime Message-ID: Update of /project/slime/cvsroot/slime In directory cl-net:/tmp/cvs-serv29005 Modified Files: ChangeLog swank-loader.lisp Log Message: Better integration with ASDF. --- /project/slime/cvsroot/slime/ChangeLog 2010/10/15 22:42:14 1.2151 +++ /project/slime/cvsroot/slime/ChangeLog 2010/10/15 22:53:45 1.2152 @@ -17,6 +17,10 @@ - label-value-line* will evaluate and splice the result of the form after a @ character + * swank-loader.lisp: Optional integration with ASDF. When ASDF is + available, store slime fasl's where ASDF would store them. Also + make sure swank.asd is visible to ASDF. + 2010-10-09 Raymond Toy * swank-cmucl.lisp (codepoint-length): Implement codepoint-length --- /project/slime/cvsroot/slime/swank-loader.lisp 2010/06/22 10:02:49 1.106 +++ /project/slime/cvsroot/slime/swank-loader.lisp 2010/10/15 22:53:45 1.107 @@ -124,12 +124,21 @@ (and s (symbol-name (read s))))) (defun default-fasl-dir () - (merge-pathnames - (make-pathname - :directory `(:relative ".slime" "fasl" - ,@(if (slime-version-string) (list (slime-version-string))) - ,(unique-dir-name))) - (user-homedir-pathname))) + (or + ;; If ASDF is available then store Slime's fasl's where ASDF stores them. + (let ((translate-fn (find-symbol "COMPILE-FILE-PATHNAME*" :asdf))) + (when translate-fn + (make-pathname + :name nil :type nil + :defaults (funcall translate-fn + (make-pathname :name "foo" + :defaults *source-directory*))))) + (merge-pathnames + (make-pathname + :directory `(:relative ".slime" "fasl" + ,@(if (slime-version-string) (list (slime-version-string))) + ,(unique-dir-name))) + (user-homedir-pathname)))) (defvar *fasl-directory* (default-fasl-dir) "The directory where fasl files should be placed.") @@ -234,6 +243,16 @@ (defun load-swank (&key (src-dir *source-directory*) (fasl-dir *fasl-directory*)) + (when (find-package :asdf) + ;; Make sure our swank.asd is visible to ASDF. + (eval + (let ((*package* (find-package :swank-loader))) + (read-from-string + "(let ((swank-system (asdf:find-system :swank nil))) + (unless (and swank-system + (equal (asdf:component-pathname swank-system) + (merge-pathnames \"swank.asd\" *source-directory*))) + (push *source-directory* asdf:*central-registry*)))")))) (compile-files (src-files *swank-files* src-dir) fasl-dir t) (funcall (q "swank::before-init") (slime-version-string) From sboukarev at common-lisp.net Sat Oct 16 10:10:38 2010 From: sboukarev at common-lisp.net (CVS User sboukarev) Date: Sat, 16 Oct 2010 06:10:38 -0400 Subject: [slime-cvs] CVS slime Message-ID: Update of /project/slime/cvsroot/slime In directory cl-net:/tmp/cvs-serv10545 Modified Files: ChangeLog swank-loader.lisp Log Message: * swank-loader.lisp (default-fasl-dir): Guard against using :asdf package if it doesn't exist. Patch by Anton Vodonosov. --- /project/slime/cvsroot/slime/ChangeLog 2010/10/15 22:53:45 1.2152 +++ /project/slime/cvsroot/slime/ChangeLog 2010/10/16 10:10:38 1.2153 @@ -1,3 +1,9 @@ +2010-10-16 Stas Boukarev + + * swank-loader.lisp (default-fasl-dir): Guard against using :asdf + package if it doesn't exist. + Patch by Anton Vodonosov. + 2010-10-16 Attila Lendvai * swank-fuzzy.lisp: speed up by 2-4 times (on sbcl). --- /project/slime/cvsroot/slime/swank-loader.lisp 2010/10/15 22:53:45 1.107 +++ /project/slime/cvsroot/slime/swank-loader.lisp 2010/10/16 10:10:38 1.108 @@ -126,7 +126,8 @@ (defun default-fasl-dir () (or ;; If ASDF is available then store Slime's fasl's where ASDF stores them. - (let ((translate-fn (find-symbol "COMPILE-FILE-PATHNAME*" :asdf))) + (let ((translate-fn (and (find-package :asdf) + (find-symbol "COMPILE-FILE-PATHNAME*" :asdf)))) (when translate-fn (make-pathname :name nil :type nil From heller at common-lisp.net Sun Oct 17 10:17:31 2010 From: heller at common-lisp.net (CVS User heller) Date: Sun, 17 Oct 2010 06:17:31 -0400 Subject: [slime-cvs] CVS slime/contrib Message-ID: Update of /project/slime/cvsroot/slime/contrib In directory cl-net:/tmp/cvs-serv29636/contrib Modified Files: ChangeLog swank-kawa.scm Log Message: Some updates to the Kawa backend. * swank-kawa.scm (%%runnable): Use standard gnu.mapping.RunnableClosure but print the stacktrace on exceptions. (listener-loop): Invoke debugger on unhandled exceptions. The debugger will use stacksnapshots if the exception matches. (invoke-debugger, break, breakpoint, request-breakpoint): New. Used to "invoke" the debugger from normal code. (process-vm-event, debug-info, event-stacktrace): Handle breakpoint events. (interrupt-thread, throwable-stacktrace, breakpoint-condition): New. (throw-to-toplevel): For breakpoint events use Thread#forceEarlyReturn. (typecase): Add support for or and eql types. (bytemethod>src-loc): New. (src-loc>elisp): Use stratum "java" as this seems to work better. (print-object, print-unreadable-object): New (pprint-to-string): Use it. --- /project/slime/cvsroot/slime/contrib/ChangeLog 2010/09/26 18:10:33 1.423 +++ /project/slime/cvsroot/slime/contrib/ChangeLog 2010/10/17 10:17:31 1.424 @@ -1,3 +1,26 @@ +2010-10-17 Helmut Eller + + Some updates to the Kawa backend. + + * swank-kawa.scm (%%runnable): Use standard + gnu.mapping.RunnableClosure but print the stacktrace on + exceptions. + (listener-loop): Invoke debugger on unhandled exceptions. The + debugger will use stacksnapshots if the exception matches. + (invoke-debugger, break, breakpoint, request-breakpoint): New. + Used to "invoke" the debugger from normal code. + (process-vm-event, debug-info, event-stacktrace): Handle + breakpoint events. + (interrupt-thread, throwable-stacktrace, breakpoint-condition): + New. + (throw-to-toplevel): For breakpoint events use + Thread#forceEarlyReturn. + (typecase): Add support for or and eql types. + (bytemethod>src-loc): New. + (src-loc>elisp): Use stratum "java" as this seems to work better. + (print-object, print-unreadable-object): New + (pprint-to-string): Use it. + 2010-09-26 Stas Boukarev * slime-repl.el (slime-repl-history-pattern): Match \t too, --- /project/slime/cvsroot/slime/contrib/swank-kawa.scm 2010/09/03 07:25:24 1.23 +++ /project/slime/cvsroot/slime/contrib/swank-kawa.scm 2010/10/17 10:17:31 1.24 @@ -24,9 +24,9 @@ (defun kawa-slime-init (file _) (setq slime-protocol-version 'ignore) - (let ((zip ".../slime/contrib/swank-kawa.zip")) ; <-- insert the right path + (let ((swank ".../slime/contrib/swank-kawa.scm")) ; <-- insert the right path (format "%S\n" - `(begin (load ,(expand-file-name zip)) (start-swank ,file))))) + `(begin (require ,(expand-file-name swank)) (start-swank ,file))))) |# ;; 4. Start everything with M-- M-x slime kawa ;; @@ -34,7 +34,7 @@ ;;;; Module declaration -(module-export start-swank create-swank-server swank-java-source-path) +(module-export start-swank create-swank-server swank-java-source-path break) (module-static #t) @@ -51,9 +51,9 @@ (define-syntax df (syntax-rules (=>) ((df name (args ... => return-type) body ...) - (define (name args ...) :: return-type body ...)) + (define (name args ...) :: return-type (seq body ...))) ((df name (args ...) body ...) - (define (name args ...) body ...)))) + (define (name args ...) (seq body ...))))) (define-syntax fun (syntax-rules () @@ -67,7 +67,9 @@ (define-syntax seq (syntax-rules () - ((seq body ...) + ((seq) + (begin #!void)) + ((seq body ...) (begin body ...)))) (define-syntax esc @@ -192,8 +194,8 @@ (result #!null)) (if (instance? tmp ) (let ((tmp :: tmp)) - (mif (p (@ car tmp)) - (mif (ps (@ cdr tmp)) + (mif (p (! get-car tmp)) + (mif (ps (! get-cdr tmp)) (set! result then) (set! fail? -1)) (set! fail? -1))) @@ -205,8 +207,8 @@ (tmp value)) (if (instance? tmp ) (let ((tmp :: tmp)) - (mif (p (@ car tmp)) - (mif (ps (@ cdr tmp)) + (mif (p (! get-car tmp)) + (mif (ps (! get-cdr tmp)) then (fail)) (fail))) @@ -241,20 +243,42 @@ ((mlet* ((pattern value) ms ...) body ...) (mlet (pattern value) (mlet* (ms ...) body ...))))) -(define-syntax typecase - (syntax-rules (::) - ((typecase var (type body ...) ...) +(define-syntax typecase% + (syntax-rules (eql or) + ((typecase% var (#t body ...) more ...) + (seq body ...)) + ((typecase% var ((eql value) body ...) more ...) + (cond ((eqv? var 'value) body ...) + (else (typecase% var more ...)))) + ((typecase% var ((or type) body ...) more ...) + (typecase% var (type body ...) more ...)) + ((typecase% var ((or type ...) body ...) more ...) + (let ((f (lambda (var) body ...))) + (typecase% var + (type (f var)) ... + (#t (typecase% var more ...))))) + ((typecase% var (type body ...) more ...) (cond ((instance? var type) (let ((var :: type var)) body ...)) - ... - (else (error "typecase failed" var - (! getClass (as