From sboukarev at common-lisp.net Sat Apr 3 10:33:54 2010 From: sboukarev at common-lisp.net (CVS User sboukarev) Date: Sat, 03 Apr 2010 06:33:54 -0400 Subject: [slime-cvs] CVS slime/contrib Message-ID: Update of /project/slime/cvsroot/slime/contrib In directory cl-net:/tmp/cvs-serv19587 Modified Files: ChangeLog slime-autodoc.el swank-arglists.lisp Log Message: * swank-arglists.lisp (arglist-dispatch): Handle method qualifiers. (print-arg): Renamed from princ-arg. (prin1-arg): Removed. * slime-autodoc.el (autodoc.1): Add test-case for method qualifiers. --- /project/slime/cvsroot/slime/contrib/ChangeLog 2010/03/30 02:07:10 1.361 +++ /project/slime/cvsroot/slime/contrib/ChangeLog 2010/04/03 10:33:53 1.362 @@ -1,3 +1,10 @@ +2010-04-03 Stas Boukarev + + * swank-arglists.lisp (arglist-dispatch): Handle method qualifiers. + (print-arg): Renamed from princ-arg. + (prin1-arg): Removed. + * slime-autodoc.el (autodoc.1): Add test-case for method qualifiers + 2010-03-30 Stas Boukarev * swank-arglists.lisp (*arglist-show-packages*): New --- /project/slime/cvsroot/slime/contrib/slime-autodoc.el 2010/03/23 20:24:16 1.38 +++ /project/slime/cvsroot/slime/contrib/slime-autodoc.el 2010/04/03 10:33:53 1.39 @@ -289,6 +289,8 @@ ;; Test context-sensitive autodoc (DEFMETHOD) ("(defmethod swank::arglist-dispatch (*HERE*" "(defmethod arglist-dispatch (===> operator <=== arguments) &body body)") + ("(defmethod swank::arglist-dispatch :before (*HERE*" + "(defmethod arglist-dispatch :before (===> operator <=== arguments) &body body)") ;; Test context-sensitive autodoc (APPLY) ("(apply 'swank::eval-for-emacs*HERE*" @@ -302,9 +304,9 @@ ;; Test context-sensitive autodoc (ERROR, CERROR) ("(error 'simple-condition*HERE*" - "(error 'simple-condition &rest arguments &key format-arguments format-control)") + "(error 'simple-condition &rest arguments &key :format-arguments :format-control)") ("(cerror \"Foo\" 'simple-condition*HERE*" - "(cerror \"Foo\" 'simple-condition &rest arguments &key format-arguments format-control)") + "(cerror \"Foo\" 'simple-condition &rest arguments &key :format-arguments :format-control)") ;; Test &KEY and nested arglists ("(swank::with-retry-restart (:msg *HERE*" --- /project/slime/cvsroot/slime/contrib/swank-arglists.lisp 2010/03/30 02:07:10 1.61 +++ /project/slime/cvsroot/slime/contrib/swank-arglists.lisp 2010/04/03 10:33:53 1.62 @@ -251,19 +251,19 @@ (let ((index 0)) (pprint-logical-block (nil nil :prefix "(" :suffix ")") (when operator - (princ-arg operator) + (print-arg operator) (pprint-indent :current 1)) ; 1 due to possibly added space (do-decoded-arglist (remove-given-args arglist provided-args) (&provided (arg) (space) - (princ-arg arg) + (print-arg arg) (incf index)) (&required (arg) (space) (if (arglist-p arg) (print-arglist-recursively arg :index index) (with-highlighting (:index index) - (princ-arg arg))) + (print-arg arg))) (incf index)) (&optional :initially (when (arglist.optional-args arglist) @@ -275,7 +275,7 @@ (print-arglist-recursively arg :index index) (with-highlighting (:index index) (if (null init-value) - (princ-arg arg) + (print-arg arg) (format t "~:@<~A ~S~@:>" arg init-value)))) (incf index)) (&key :initially @@ -296,7 +296,7 @@ ((not (keywordp keyword)) (format t "~:@<(~S ..)~@:>" keyword)) (t - (princ-arg keyword)))))) + (print-arg keyword)))))) (&key :finally (when (arglist.allow-other-keys-p arglist) (space) @@ -315,20 +315,17 @@ (if (arglist-p args) (print-arglist-recursively args :index index) (with-highlighting (:index index) - (princ-arg args)))) + (print-arg args)))) ;; FIXME: add &UNKNOWN-JUNK? ))))) - -(defun princ-arg (arg) - (princ (if (arglist-dummy-p arg) - (arglist-dummy.string-representation arg) - arg))) - -(defun prin1-arg (arg) - (if (arglist-dummy-p arg) - (princ (arglist-dummy.string-representation arg)) - (prin1 arg))) +(defun print-arg (arg) + (let ((arg (if (arglist-dummy-p arg) + (arglist-dummy.string-representation arg) + arg))) + (if (keywordp arg) + (prin1 arg) + (princ arg)))) (defun print-decoded-arglist-as-template (decoded-arglist &key (prefix "(") (suffix ")")) @@ -986,14 +983,17 @@ (defmethod arglist-dispatch ((operator (eql 'defmethod)) arguments) (match (cons operator arguments) - (('defmethod (#'valid-function-name-p gf-name) . _) + (('defmethod (#'valid-function-name-p gf-name) . rest) (let ((gf (fdefinition gf-name))) (when (typep gf 'generic-function) (with-available-arglist (arglist) (decode-arglist (arglist gf)) - (return-from arglist-dispatch - (make-arglist :provided-args (list gf-name) - :required-args (list arglist) - :rest "body" :body-p t)))))) + (let ((qualifiers (loop for x in rest + until (or (listp x) (empty-arg-p x)) + collect x))) + (return-from arglist-dispatch + (make-arglist :provided-args (cons gf-name qualifiers) + :required-args (list arglist) + :rest "body" :body-p t))))))) (_)) ; Fall through (call-next-method)) From sboukarev at common-lisp.net Sat Apr 3 14:03:54 2010 From: sboukarev at common-lisp.net (CVS User sboukarev) Date: Sat, 03 Apr 2010 10:03:54 -0400 Subject: [slime-cvs] CVS slime/contrib Message-ID: Update of /project/slime/cvsroot/slime/contrib In directory cl-net:/tmp/cvs-serv4254 Modified Files: ChangeLog slime-autodoc.el swank-arglists.lisp Log Message: * swank-arglists.lisp (print-decoded-arglist): Print keywords using princ again. --- /project/slime/cvsroot/slime/contrib/ChangeLog 2010/04/03 10:33:53 1.362 +++ /project/slime/cvsroot/slime/contrib/ChangeLog 2010/04/03 14:03:53 1.363 @@ -1,5 +1,10 @@ 2010-04-03 Stas Boukarev + * swank-arglists.lisp (print-decoded-arglist): Print keywords using + princ again. + +2010-04-03 Stas Boukarev + * swank-arglists.lisp (arglist-dispatch): Handle method qualifiers. (print-arg): Renamed from princ-arg. (prin1-arg): Removed. --- /project/slime/cvsroot/slime/contrib/slime-autodoc.el 2010/04/03 10:33:53 1.39 +++ /project/slime/cvsroot/slime/contrib/slime-autodoc.el 2010/04/03 14:03:53 1.40 @@ -304,9 +304,9 @@ ;; Test context-sensitive autodoc (ERROR, CERROR) ("(error 'simple-condition*HERE*" - "(error 'simple-condition &rest arguments &key :format-arguments :format-control)") + "(error 'simple-condition &rest arguments &key format-arguments format-control)") ("(cerror \"Foo\" 'simple-condition*HERE*" - "(cerror \"Foo\" 'simple-condition &rest arguments &key :format-arguments :format-control)") + "(cerror \"Foo\" 'simple-condition &rest arguments &key format-arguments format-control)") ;; Test &KEY and nested arglists ("(swank::with-retry-restart (:msg *HERE*" --- /project/slime/cvsroot/slime/contrib/swank-arglists.lisp 2010/04/03 10:33:53 1.62 +++ /project/slime/cvsroot/slime/contrib/swank-arglists.lisp 2010/04/03 14:03:53 1.63 @@ -296,7 +296,7 @@ ((not (keywordp keyword)) (format t "~:@<(~S ..)~@:>" keyword)) (t - (print-arg keyword)))))) + (princ keyword)))))) (&key :finally (when (arglist.allow-other-keys-p arglist) (space) From sboukarev at common-lisp.net Sat Apr 3 17:00:04 2010 From: sboukarev at common-lisp.net (CVS User sboukarev) Date: Sat, 03 Apr 2010 13:00:04 -0400 Subject: [slime-cvs] CVS slime/contrib Message-ID: Update of /project/slime/cvsroot/slime/contrib In directory cl-net:/tmp/cvs-serv21316 Modified Files: ChangeLog swank-arglists.lisp Log Message: * swank-arglists.lisp (print-decoded-arglist): prin1-arg -> print-arg. --- /project/slime/cvsroot/slime/contrib/ChangeLog 2010/04/03 14:03:53 1.363 +++ /project/slime/cvsroot/slime/contrib/ChangeLog 2010/04/03 17:00:04 1.364 @@ -1,5 +1,9 @@ 2010-04-03 Stas Boukarev + * swank-arglists.lisp (print-decoded-arglist): prin1-arg -> print-arg. + +2010-04-03 Stas Boukarev + * swank-arglists.lisp (print-decoded-arglist): Print keywords using princ again. --- /project/slime/cvsroot/slime/contrib/swank-arglists.lisp 2010/04/03 14:03:53 1.63 +++ /project/slime/cvsroot/slime/contrib/swank-arglists.lisp 2010/04/03 17:00:04 1.64 @@ -307,7 +307,7 @@ (princ '&any))) (&any (arg) (space) - (prin1-arg arg)) + (print-arg arg)) (&rest (args bodyp) (space) (princ (if bodyp '&body '&rest)) From sboukarev at common-lisp.net Sat Apr 3 20:52:52 2010 From: sboukarev at common-lisp.net (CVS User sboukarev) Date: Sat, 03 Apr 2010 16:52:52 -0400 Subject: [slime-cvs] CVS slime Message-ID: Update of /project/slime/cvsroot/slime In directory cl-net:/tmp/cvs-serv14509 Modified Files: ChangeLog slime.el swank-allegro.lisp Log Message: * slime.el (slime-update-threads-buffer): New formatting, with labels and additional information provided by the backend. * swank-allegro.lisp (thread-attributes): Move process-priority from thread-status. --- /project/slime/cvsroot/slime/ChangeLog 2010/03/29 15:57:44 1.2050 +++ /project/slime/cvsroot/slime/ChangeLog 2010/04/03 20:52:52 1.2051 @@ -1,3 +1,10 @@ +2010-04-03 Stas Boukarev + + * slime.el (slime-update-threads-buffer): New formatting, with labels + and additional information provided by the backend. + * swank-allegro.lisp (thread-attributes): Move process-priority from + thread-status. + 2010-03-29 Helmut Eller * slime.el: Add gud as compile-time dependency. --- /project/slime/cvsroot/slime/slime.el 2010/03/29 15:57:44 1.1291 +++ /project/slime/cvsroot/slime/slime.el 2010/04/03 20:52:52 1.1292 @@ -6186,34 +6186,70 @@ (interactive) (let ((name slime-threads-buffer-name)) (slime-with-popup-buffer (name nil t) - (slime-update-threads-buffer) (slime-thread-control-mode) + (slime-update-threads-buffer) (setq slime-popup-buffer-quit-function 'slime-quit-threads-buffer)))) +(defun slime-longest-lines (list-of-lines) + (let ((lengths (make-list (length (car list-of-lines)) 0))) + (flet ((process-line (line) + (loop for element in line + for length on lengths + do (setf (car length) + (max (length (prin1-to-string element t)) + (car length)))))) + (mapc 'process-line list-of-lines) + lengths))) + (defun slime-quit-threads-buffer (&optional _) (slime-eval-async `(swank:quit-thread-browser)) (slime-popup-buffer-quit t)) (defun slime-update-threads-buffer () (interactive) - (let ((threads (cdr (slime-eval '(swank:list-threads))))) + (let ((threads (slime-eval '(swank:list-threads)))) (with-current-buffer slime-threads-buffer-name (let ((inhibit-read-only t)) (erase-buffer) - (loop for idx from 0 - for (id name status) in threads - do (slime-thread-insert idx name status id)) + (slime-insert-threads threads) (goto-char (point-min)))))) -(defun slime-thread-insert (idx name status id) - (slime-propertize-region `(thread-id ,idx) - (insert (format "%3s: " id)) - (slime-insert-propertized '(face bold) name) - (insert-char ?\ (- 30 (current-column))) - (let ((start (point))) - (insert " " status) - (unless (bolp) (insert "\n")) - (indent-rigidly start (point) 2)))) +(defvar *slime-threads-table-properties* + '(nil (face bold))) + +(defun slime-format-threads-labels (threads) + (let ((labels (mapcar (lambda (x) + (capitalize (substring (symbol-name x) 1))) + (car threads)))) + (cons labels (cdr threads)))) + +(defun slime-insert-thread (thread longest-lines) + (unless (bolp) (insert "\n")) + (loop for i from 0 + for align in longest-lines + for element in thread + for string = (prin1-to-string element t) + for property = (nth i *slime-threads-table-properties*) + do + (if property + (slime-insert-propertized property string) + (insert string)) + (insert-char ?\ (- align (length string) -3)))) + +(defun slime-insert-threads (threads) + (let* ((threads (slime-format-threads-labels threads)) + (longest-lines (slime-longest-lines threads))) + (setq header-line-format + (concat (propertize " " 'display '((space :align-to 0))) + (let (*slime-threads-table-properties*) + (with-temp-buffer + (slime-insert-thread (car threads) longest-lines) + (buffer-string))))) + (loop for thread-id from 0 + for thread in (cdr threads) + do + (slime-propertize-region `(thread-id ,thread-id) + (slime-insert-thread thread longest-lines))))) ;;;;; Major mode --- /project/slime/cvsroot/slime/swank-allegro.lisp 2010/03/09 09:20:13 1.139 +++ /project/slime/cvsroot/slime/swank-allegro.lisp 2010/04/03 20:52:52 1.140 @@ -758,8 +758,11 @@ (mp:process-name thread)) (defimplementation thread-status (thread) - (format nil "~A ~D" (mp:process-whostate thread) - (mp:process-priority thread))) + (princ-to-string (mp:process-whostate thread))) + +(defimplementation thread-attributes (thread) + (list :priority (mp:process-priority thread) + :times-resumed (mp:process-times-resumed thread))) (defimplementation make-lock (&key name) (mp:make-process-lock :name name)) From sboukarev at common-lisp.net Sun Apr 4 21:47:10 2010 From: sboukarev at common-lisp.net (CVS User sboukarev) Date: Sun, 04 Apr 2010 17:47:10 -0400 Subject: [slime-cvs] CVS slime Message-ID: Update of /project/slime/cvsroot/slime In directory cl-net:/tmp/cvs-serv26315 Modified Files: ChangeLog slime.el Log Message: * slime.el (slime-with-popup-buffer): Make &optional parameters &key parameters, add modes parameter. slime-with-popup-buffer sets up some buffer local variables, but enabling major modes kills all buffer locals, so modes should be enabled before setting them. Adopt changes to slime-with-popup-buffer where needed. This fixes several bugs with popup buffers on non-default connections. --- /project/slime/cvsroot/slime/ChangeLog 2010/04/03 20:52:52 1.2051 +++ /project/slime/cvsroot/slime/ChangeLog 2010/04/04 21:47:10 1.2052 @@ -1,3 +1,13 @@ +2010-04-04 Stas Boukarev + + * slime.el (slime-with-popup-buffer): Make &optional parameters + &key parameters, add modes parameter. + slime-with-popup-buffer sets up some buffer local variables, + but enabling major modes kills all buffer locals, so modes should + be enabled before setting them. + Adopt changes to slime-with-popup-buffer where needed. + This fixes several bugs with popup buffers on non-default connections. + 2010-04-03 Stas Boukarev * slime.el (slime-update-threads-buffer): New formatting, with labels --- /project/slime/cvsroot/slime/slime.el 2010/04/03 20:52:52 1.1292 +++ /project/slime/cvsroot/slime/slime.el 2010/04/04 21:47:10 1.1293 @@ -873,7 +873,7 @@ (defvar slime-buffer-connection) ;; Interface -(defmacro* slime-with-popup-buffer ((name &optional package connection select) +(defmacro* slime-with-popup-buffer ((name &key package connection select modes) &body body) "Similar to `with-output-to-temp-buffer'. Bind standard-output and initialize some buffer-local variables. @@ -882,23 +882,23 @@ NAME is the name of the buffer to be created. PACKAGE is the value `slime-buffer-package'. CONNECTION is the value for `slime-buffer-connection'. +MODES is the list of mode commands. If nil, no explicit connection is associated with the buffer. If t, the current connection is taken. " `(let* ((vars% (list ,(if (eq package t) '(slime-current-package) package) ,(if (eq connection t) '(slime-connection) connection))) - (standard-output (slime-make-popup-buffer ,name vars%))) + (standard-output (slime-make-popup-buffer ,name vars% ,modes))) (with-current-buffer standard-output (prog1 (progn , at body) (assert (eq (current-buffer) standard-output)) - (slime-init-popup-buffer vars%) (setq buffer-read-only t) - (set-window-point (slime-display-popup-buffer ,(or select 'nil)) + (set-window-point (slime-display-popup-buffer ,(or select nil)) (point)))))) (put 'slime-with-popup-buffer 'lisp-indent-function 1) -(defun slime-make-popup-buffer (name buffer-vars) +(defun slime-make-popup-buffer (name buffer-vars modes) "Return a temporary buffer called NAME. The buffer also uses the minor-mode `slime-popup-buffer-mode'." (with-current-buffer (get-buffer-create name) @@ -906,10 +906,14 @@ (setq buffer-read-only nil) (erase-buffer) (set-syntax-table lisp-mode-syntax-table) - (slime-init-popup-buffer buffer-vars) + (slime-init-popup-buffer buffer-vars modes) (current-buffer))) -(defun slime-init-popup-buffer (buffer-vars) +(defun slime-init-popup-buffer (buffer-vars modes) + (dolist (mode modes) + (if (memq mode minor-mode-list) + (funcall mode 1) + (funcall mode))) (slime-popup-buffer-mode 1) (multiple-value-setq (slime-buffer-package slime-buffer-connection) buffer-vars)) @@ -4099,7 +4103,9 @@ ;; for comparing the output of DISASSEMBLE across implementations. ;; FIXME: could easily be achieved with M-x rename-buffer (let ((bufname (format "*SLIME Description <%s>*" (slime-connection-name)))) - (slime-with-popup-buffer (bufname package t slime-description-autofocus) + (slime-with-popup-buffer (bufname :package package + :connection t + :select slime-description-autofocus) (princ string) (goto-char (point-min))))) @@ -4183,16 +4189,18 @@ (defun slime-edit-value-callback (form-string current-value package) (let* ((name (generate-new-buffer-name (format "*Edit %s*" form-string))) - (buffer (slime-with-popup-buffer (name package t t) - (lisp-mode) - (slime-mode 1) - (slime-popup-buffer-mode -1) ; don't want binding of 'q' - (slime-edit-value-mode 1) - (setq slime-edit-form-string form-string) - (insert current-value) - (current-buffer)))) + (buffer (slime-with-popup-buffer (name :package package + :connection t + :select t + :modes '(lisp-mode slime-mode + slime-edit-value-mode)) + (slime-popup-buffer-mode -1) ; don't want binding of 'q' + (setq slime-edit-form-string form-string) + (insert current-value) + (current-buffer)))) (with-current-buffer buffer - (setq buffer-read-only nil)))) + (setq buffer-read-only nil) + (message "Type C-c C-c when done")))) (defun slime-edit-value-commit () "Commit the edited value to the Lisp image. @@ -4610,15 +4618,16 @@ (defun slime-show-apropos (plists string package summary) (if (null plists) (message "No apropos matches for %S" string) - (slime-with-popup-buffer ("*SLIME Apropos*" package t) - (apropos-mode) - (if (boundp 'header-line-format) - (setq header-line-format summary) - (insert summary "\n\n")) - (slime-set-truncate-lines) - (slime-print-apropos plists) - (set-syntax-table lisp-mode-syntax-table) - (goto-char (point-min))))) + (slime-with-popup-buffer ("*SLIME Apropos*" + :package package :connection t + :modes '(apropos-mode)) + (if (boundp 'header-line-format) + (setq header-line-format summary) + (insert summary "\n\n")) + (slime-set-truncate-lines) + (slime-print-apropos plists) + (set-syntax-table lisp-mode-syntax-table) + (goto-char (point-min))))) (defvar slime-apropos-label-properties (progn @@ -4724,10 +4733,12 @@ "Execute BODY in a xref buffer, then show that buffer." `(let ((xref-buffer-name% (format "*slime xref[%s: %s]*" ,xref-type ,symbol))) - (slime-with-popup-buffer (xref-buffer-name% ,package t t) - (slime-xref-mode) + (slime-with-popup-buffer (xref-buffer-name% + :package ,package + :connection t + :select t + :modes '(slime-xref-mode)) (slime-set-truncate-lines) - (erase-buffer) , at body))) (put 'slime-with-xref-buffer 'lisp-indent-function 1) @@ -5120,10 +5131,10 @@ (defun slime-create-macroexpansion-buffer () (let ((name "*SLIME Macroexpansion*")) - (slime-with-popup-buffer (name t t) - (lisp-mode) - (slime-mode 1) - (slime-macroexpansion-minor-mode 1) + (slime-with-popup-buffer (name :package t :connection t + :modes '(lisp-mode + slime-mode + slime-macroexpansion-minor-mode)) (setq font-lock-keywords-case-fold-search t) (current-buffer)))) @@ -6185,8 +6196,8 @@ "Display a list of threads." (interactive) (let ((name slime-threads-buffer-name)) - (slime-with-popup-buffer (name nil t) - (slime-thread-control-mode) + (slime-with-popup-buffer (name :connection t + :modes '(slime-thread-control-mode)) (slime-update-threads-buffer) (setq slime-popup-buffer-quit-function 'slime-quit-threads-buffer)))) From sboukarev at common-lisp.net Sun Apr 4 21:51:54 2010 From: sboukarev at common-lisp.net (CVS User sboukarev) Date: Sun, 04 Apr 2010 17:51:54 -0400 Subject: [slime-cvs] CVS slime Message-ID: Update of /project/slime/cvsroot/slime In directory cl-net:/tmp/cvs-serv27743 Modified Files: ChangeLog slime.el Log Message: * slime.el (slime-insert-threads): Use header-line-format only when it's present (XEmacs doesn't support it). --- /project/slime/cvsroot/slime/ChangeLog 2010/04/04 21:47:10 1.2052 +++ /project/slime/cvsroot/slime/ChangeLog 2010/04/04 21:51:54 1.2053 @@ -1,5 +1,10 @@ 2010-04-04 Stas Boukarev + * slime.el (slime-insert-threads): Use header-line-format only when + it's present (XEmacs doesn't support it). + +2010-04-04 Stas Boukarev + * slime.el (slime-with-popup-buffer): Make &optional parameters &key parameters, add modes parameter. slime-with-popup-buffer sets up some buffer local variables, --- /project/slime/cvsroot/slime/slime.el 2010/04/04 21:47:10 1.1293 +++ /project/slime/cvsroot/slime/slime.el 2010/04/04 21:51:54 1.1294 @@ -6249,13 +6249,16 @@ (defun slime-insert-threads (threads) (let* ((threads (slime-format-threads-labels threads)) - (longest-lines (slime-longest-lines threads))) - (setq header-line-format - (concat (propertize " " 'display '((space :align-to 0))) - (let (*slime-threads-table-properties*) - (with-temp-buffer - (slime-insert-thread (car threads) longest-lines) - (buffer-string))))) + (longest-lines (slime-longest-lines threads)) + (labels (let (*slime-threads-table-properties*) + (with-temp-buffer + (slime-insert-thread (car threads) longest-lines) + (buffer-string))))) + (if (boundp 'header-line-format) + (setq header-line-format + (concat (propertize " " 'display '((space :align-to 0))) + labels)) + (insert labels)) (loop for thread-id from 0 for thread in (cdr threads) do From sboukarev at common-lisp.net Mon Apr 5 10:53:02 2010 From: sboukarev at common-lisp.net (CVS User sboukarev) Date: Mon, 05 Apr 2010 06:53:02 -0400 Subject: [slime-cvs] CVS slime Message-ID: Update of /project/slime/cvsroot/slime In directory cl-net:/tmp/cvs-serv2431 Modified Files: ChangeLog slime.el Log Message: * slime-sprof.el (slime-sprof-browser): Use slime-with-popup-buffer for buffer creation. * slime.el: Some further adaptations to the new slime-with-popup-buffer. --- /project/slime/cvsroot/slime/ChangeLog 2010/04/04 21:51:54 1.2053 +++ /project/slime/cvsroot/slime/ChangeLog 2010/04/05 10:53:02 1.2054 @@ -1,3 +1,7 @@ +2010-04-05 Stas Boukarev + + * slime.el: Some further adaptations to the new slime-with-popup-buffer. + 2010-04-04 Stas Boukarev * slime.el (slime-insert-threads): Use header-line-format only when --- /project/slime/cvsroot/slime/slime.el 2010/04/04 21:51:54 1.1294 +++ /project/slime/cvsroot/slime/slime.el 2010/04/05 10:53:02 1.1295 @@ -2793,7 +2793,8 @@ (defun slime-show-compilation-log (notes) "Create and display the compilation log buffer." (interactive (list (slime-compiler-notes))) - (slime-with-popup-buffer ("*SLIME Compilation*") + (slime-with-popup-buffer ("*SLIME Compilation*" + :modes '(compilation-mode)) (slime-insert-compilation-log notes))) (defun slime-insert-compilation-log (notes) @@ -2812,7 +2813,6 @@ (slime-insert-note-group notes) (insert "\n") (slime-make-note-overlay (first notes) start (1- (point)))))) - (compilation-mode) (set (make-local-variable 'compilation-skip-threshold) 0) (setq next-error-last-buffer (current-buffer))))) @@ -6368,8 +6368,8 @@ (defun slime-list-connections () "Display a list of all connections." (interactive) - (slime-with-popup-buffer (slime-connections-buffer-name) - (slime-connection-list-mode) + (slime-with-popup-buffer (slime-connections-buffer-name + :modes '(slime-connection-list-mode)) (slime-draw-connection-list))) (defun slime-update-connection-list () From sboukarev at common-lisp.net Mon Apr 5 10:53:02 2010 From: sboukarev at common-lisp.net (CVS User sboukarev) Date: Mon, 05 Apr 2010 06:53:02 -0400 Subject: [slime-cvs] CVS slime/contrib Message-ID: Update of /project/slime/cvsroot/slime/contrib In directory cl-net:/tmp/cvs-serv2431/contrib Modified Files: ChangeLog slime-clipboard.el slime-compiler-notes-tree.el slime-sprof.el Log Message: * slime-sprof.el (slime-sprof-browser): Use slime-with-popup-buffer for buffer creation. * slime.el: Some further adaptations to the new slime-with-popup-buffer. --- /project/slime/cvsroot/slime/contrib/ChangeLog 2010/04/03 17:00:04 1.364 +++ /project/slime/cvsroot/slime/contrib/ChangeLog 2010/04/05 10:53:02 1.365 @@ -1,3 +1,8 @@ +2010-04-05 Stas Boukarev + + * slime-sprof.el (slime-sprof-browser): Use slime-with-popup-buffer for + buffer creation. + 2010-04-03 Stas Boukarev * swank-arglists.lisp (print-decoded-arglist): prin1-arg -> print-arg. --- /project/slime/cvsroot/slime/contrib/slime-clipboard.el 2010/02/15 21:42:37 1.3 +++ /project/slime/cvsroot/slime/contrib/slime-clipboard.el 2010/04/05 10:53:02 1.4 @@ -64,8 +64,8 @@ #'slime-clipboard-display-entries)) (defun slime-clipboard-display-entries (entries) - (slime-with-popup-buffer ("*Slime Clipboard*") - (slime-clipboard-mode) + (slime-with-popup-buffer ("*Slime Clipboard*" + :modes '(slime-clipboard-mode)) (slime-clipboard-insert-entries entries))) (defun slime-clipboard-insert-entries (entries) --- /project/slime/cvsroot/slime/contrib/slime-compiler-notes-tree.el 2009/02/25 17:54:38 1.2 +++ /project/slime/cvsroot/slime/contrib/slime-compiler-notes-tree.el 2010/04/05 10:53:02 1.3 @@ -22,9 +22,8 @@ "Show the compiler notes NOTES in tree view." (interactive (list (slime-compiler-notes))) (with-temp-message "Preparing compiler note tree..." - (slime-with-popup-buffer ("*SLIME Compiler-Notes*") - (erase-buffer) - (slime-compiler-notes-mode) + (slime-with-popup-buffer ("*SLIME Compiler-Notes*" + :modes '(slime-compiler-notes-mode)) (when (null notes) (insert "[no notes]")) (let ((collapsed-p)) --- /project/slime/cvsroot/slime/contrib/slime-sprof.el 2010/02/15 21:42:37 1.5 +++ /project/slime/cvsroot/slime/contrib/slime-sprof.el 2010/04/05 10:53:02 1.6 @@ -25,7 +25,6 @@ (slime-define-keys slime-sprof-browser-mode-map ("h" 'describe-mode) - ("q" 'bury-buffer) ("d" 'slime-sprof-browser-disassemble-function) ("g" 'slime-sprof-browser-go-to) ("v" 'slime-sprof-browser-view-source) @@ -65,17 +64,10 @@ (defun slime-sprof-browser () (interactive) - (switch-to-buffer (slime-sprof-browser-buffer)) - (slime-sprof-update)) - -(defun slime-sprof-browser-buffer () - (if (get-buffer "*slime-sprof-browser*") - (get-buffer "*slime-sprof-browser*") - (let ((connection (slime-connection))) - (with-current-buffer (get-buffer-create "*slime-sprof-browser*") - (slime-sprof-browser-mode) - (setq slime-buffer-connection connection) - (current-buffer))))) + (slime-with-popup-buffer ("*slime-sprof-browser*" + :connection t + :modes '(slime-sprof-browser-mode)) + (slime-sprof-update))) (defun slime-sprof-toggle-swank-exclusion () (interactive) From sboukarev at common-lisp.net Mon Apr 5 14:48:54 2010 From: sboukarev at common-lisp.net (CVS User sboukarev) Date: Mon, 05 Apr 2010 10:48:54 -0400 Subject: [slime-cvs] CVS slime Message-ID: Update of /project/slime/cvsroot/slime In directory cl-net:/tmp/cvs-serv17211 Modified Files: ChangeLog slime.el Log Message: * slime-autodoc.el (slime-autodoc-full): New command, displays multiline arglists. Bound to C-c C-d a. (slime-make-autodoc-rpc-form): Don't send :print-lines to autodoc, always use the actual width for :print-right-margin, remove newlines on formatting when needed. (slime-autodoc): Add optional parameter multilinep defaulted to slime-autodoc-use-multiline-p, pass it to slime-format-autodoc. * swank-arglists.lisp (autodoc, decoded-arglist-to-string): remove print-lines parameter, it's not used anymore. * slime.el (slime-doc-bindings): Move slime-apropos to C-c C-d A, C-c C-d a will be bound to slime-autodoc-full. --- /project/slime/cvsroot/slime/ChangeLog 2010/04/05 10:53:02 1.2054 +++ /project/slime/cvsroot/slime/ChangeLog 2010/04/05 14:48:54 1.2055 @@ -1,5 +1,10 @@ 2010-04-05 Stas Boukarev + * slime.el (slime-doc-bindings): Move slime-apropos to C-c C-d A, + C-c C-d a will be bound to slime-autodoc-full. + +2010-04-05 Stas Boukarev + * slime.el: Some further adaptations to the new slime-with-popup-buffer. 2010-04-04 Stas Boukarev --- /project/slime/cvsroot/slime/slime.el 2010/04/05 10:53:02 1.1295 +++ /project/slime/cvsroot/slime/slime.el 2010/04/05 14:48:54 1.1296 @@ -564,7 +564,7 @@ "Keymap for documentation commands. Bound to a prefix key.") (defvar slime-doc-bindings - '((?a slime-apropos) + '((?A slime-apropos) (?z slime-apropos-all) (?p slime-apropos-package) (?d slime-describe-symbol) From sboukarev at common-lisp.net Mon Apr 5 14:48:55 2010 From: sboukarev at common-lisp.net (CVS User sboukarev) Date: Mon, 05 Apr 2010 10:48:55 -0400 Subject: [slime-cvs] CVS slime/contrib Message-ID: Update of /project/slime/cvsroot/slime/contrib In directory cl-net:/tmp/cvs-serv17211/contrib Modified Files: ChangeLog slime-autodoc.el swank-arglists.lisp Log Message: * slime-autodoc.el (slime-autodoc-full): New command, displays multiline arglists. Bound to C-c C-d a. (slime-make-autodoc-rpc-form): Don't send :print-lines to autodoc, always use the actual width for :print-right-margin, remove newlines on formatting when needed. (slime-autodoc): Add optional parameter multilinep defaulted to slime-autodoc-use-multiline-p, pass it to slime-format-autodoc. * swank-arglists.lisp (autodoc, decoded-arglist-to-string): remove print-lines parameter, it's not used anymore. * slime.el (slime-doc-bindings): Move slime-apropos to C-c C-d A, C-c C-d a will be bound to slime-autodoc-full. --- /project/slime/cvsroot/slime/contrib/ChangeLog 2010/04/05 10:53:02 1.365 +++ /project/slime/cvsroot/slime/contrib/ChangeLog 2010/04/05 14:48:55 1.366 @@ -1,5 +1,18 @@ 2010-04-05 Stas Boukarev + * slime-autodoc.el (slime-autodoc-full): New command, + displays multiline arglists. Bound to C-c C-d a. + (slime-make-autodoc-rpc-form): Don't send + :print-lines to autodoc, always use the actual width for + :print-right-margin, remove newlines on formatting when needed. + (slime-autodoc): Add optional parameter multilinep defaulted to + slime-autodoc-use-multiline-p, pass it to slime-format-autodoc. + + * swank-arglists.lisp (autodoc, decoded-arglist-to-string): remove + print-lines parameter, it's not used anymore. + +2010-04-05 Stas Boukarev + * slime-sprof.el (slime-sprof-browser): Use slime-with-popup-buffer for buffer creation. --- /project/slime/cvsroot/slime/contrib/slime-autodoc.el 2010/04/03 14:03:53 1.40 +++ /project/slime/cvsroot/slime/contrib/slime-autodoc.el 2010/04/05 14:48:55 1.41 @@ -64,11 +64,9 @@ (buffer-form (slime-parse-form-upto-point levels))) (when buffer-form (values buffer-form - (multiple-value-bind (width height) - (slime-autodoc-message-dimensions) - `(swank:autodoc ',buffer-form - :print-right-margin ,width - :print-lines ,height)))))) + `(swank:autodoc ',buffer-form + :print-right-margin + ,(window-width (minibuffer-window))))))) (defun slime-autodoc-global-at-point () "Return the global variable name at point, if any." @@ -88,23 +86,6 @@ (and (< (length name) 80) ; avoid overflows in regexp matcher (string-match slime-global-variable-name-regexp name))) -(defvar slime-autodoc-dimensions-function nil) - -(defun slime-autodoc-message-dimensions () - "Return the available width and height for pretty printing autodoc -messages." - (cond - (slime-autodoc-dimensions-function - (funcall slime-autodoc-dimensions-function)) - (slime-autodoc-use-multiline-p - ;; Use the full width of the minibuffer; - ;; minibuffer will grow vertically if necessary - (values (window-width (minibuffer-window)) - nil)) - (t - ;; Try to fit everything in one line; we cut off when displaying - (values 1000 1)))) - ;;;; Autodoc cache @@ -125,11 +106,11 @@ ;;;; Formatting autodoc -(defun slime-format-autodoc (doc) - (setq doc (slime-fontify-string doc)) - (unless slime-autodoc-use-multiline-p - (setq doc (slime-oneliner doc))) - doc) +(defun slime-format-autodoc (doc multilinep) + (let ((doc (slime-fontify-string doc))) + (if multilinep + doc + (slime-oneliner (replace-regexp-in-string "[ \n\t]+" " " doc))))) (defun slime-fontify-string (string) "Fontify STRING as `font-lock-mode' does in Lisp mode." @@ -154,8 +135,8 @@ ;;;; slime-autodoc-mode - -(defun slime-autodoc () +(defun* slime-autodoc (&optional (multilinep slime-autodoc-use-multiline-p) + cache-multiline) "Returns the cached arglist information as string, or nil. If it's not in the cache, the cache will be updated asynchronously." (interactive) @@ -165,27 +146,49 @@ ;; data. (save-match-data (unless (slime-inside-string-or-comment-p) - (multiple-value-bind (cache-key retrieve-form) + (multiple-value-bind (cache-key retrieve-form) (slime-make-autodoc-rpc-form) - (let ((cached)) - (cond + (let* (cached + (multiline-cached (slime-autodoc-cache-multine (car cache-key) + cache-multiline)) + (multilinep (or multilinep multiline-cached))) + (cond ((not cache-key) nil) - ((setq cached (slime-get-cached-autodoc cache-key)) cached) + ((setq cached (slime-get-cached-autodoc cache-key)) + (slime-format-autodoc cached multilinep)) (t ;; If nothing is in the cache, we first decline (by ;; returning nil), and fetch the arglist information ;; asynchronously. (slime-eval-async retrieve-form - (lexical-let ((cache-key cache-key)) + (lexical-let ((cache-key cache-key) + (multilinep multilinep)) (lambda (doc) - (unless (eq doc :not-available) - (setq doc (slime-format-autodoc doc)) + (unless (eq doc :not-available) + (slime-store-into-autodoc-cache cache-key doc) ;; Now that we've got our information, ;; get it to the user ASAP. - (eldoc-message doc) - (slime-store-into-autodoc-cache cache-key doc))))) + (eldoc-message + (slime-format-autodoc doc multilinep)))))) nil)))))))) +(defvar slime-autodoc-cache-car nil) + +(defun slime-autodoc-cache-multine (cache-key cache-new-p) + (cond (cache-new-p + (setq slime-autodoc-cache-car + cache-key)) + ((not (equal cache-key + slime-autodoc-cache-car)) + (setq slime-autodoc-cache-car nil))) + (equal cache-key + slime-autodoc-cache-car)) + +(defun slime-autodoc-full () + "Like slime-autodoc, but with slime-autodoc-use-multiline-p enabled" + (interactive) + (eldoc-message (slime-autodoc t t))) + (make-variable-buffer-local (defvar slime-autodoc-mode nil)) (defun slime-autodoc-mode (&optional arg) @@ -211,7 +214,8 @@ (not (active-minibuffer-window)) ;; Display arglist only when inferior Lisp will be able ;; to cope with the request. - (slime-background-activities-enabled-p)))) + (slime-background-activities-enabled-p))) + (slime-bind-keys slime-doc-map t '((?a slime-autodoc-full)))) ad-return-value) --- /project/slime/cvsroot/slime/contrib/swank-arglists.lisp 2010/04/03 17:00:04 1.64 +++ /project/slime/cvsroot/slime/contrib/swank-arglists.lisp 2010/04/05 14:48:55 1.65 @@ -386,11 +386,10 @@ (defun decoded-arglist-to-string (decoded-arglist &key operator highlight - print-right-margin print-lines) + print-right-margin) (with-output-to-string (*standard-output*) (with-arglist-io-syntax - (let ((*print-right-margin* print-right-margin) - (*print-lines* print-lines)) + (let ((*print-right-margin* print-right-margin)) (print-decoded-arglist decoded-arglist :operator operator :highlight highlight))))) @@ -1102,32 +1101,30 @@ ;;; %CURSOR-MARKER%)). Only the forms up to point should be ;;; considered. -(defslimefun autodoc (raw-form &key print-right-margin print-lines) +(defslimefun autodoc (raw-form &key print-right-margin) "Return a string representing the arglist for the deepest subform in RAW-FORM that does have an arglist. The highlighted parameter is wrapped in ===> X <===." (handler-bind ((serious-condition #'(lambda (c) (unless (debug-on-swank-error) - (let ((*print-right-margin* print-right-margin) - (*print-lines* print-lines)) + (let ((*print-right-margin* print-right-margin)) (return-from autodoc (format nil "Arglist Error: \"~A\"" c))))))) - (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) - (print-variable-to-string obj-at-cursor)) - (t - (with-available-arglist (arglist) arglist - (decoded-arglist-to-string - arglist - :print-right-margin print-right-margin - :print-lines print-lines - :operator (car form) - :highlight (form-path-to-arglist-path form-path - form - arglist))))))))) + (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) + (print-variable-to-string obj-at-cursor)) + (t + (with-available-arglist (arglist) arglist + (decoded-arglist-to-string + arglist + :print-right-margin print-right-margin + :operator (car form) + :highlight (form-path-to-arglist-path form-path + form + arglist))))))))) (defun print-variable-to-string (symbol) "Return a short description of VARIABLE-NAME, or NIL." From sboukarev at common-lisp.net Mon Apr 5 15:15:22 2010 From: sboukarev at common-lisp.net (CVS User sboukarev) Date: Mon, 05 Apr 2010 11:15:22 -0400 Subject: [slime-cvs] CVS slime/contrib Message-ID: Update of /project/slime/cvsroot/slime/contrib In directory cl-net:/tmp/cvs-serv2369 Modified Files: ChangeLog slime-autodoc.el Log Message: * slime-autodoc.el (slime-autodoc-manually): Rename from slime-autodoc-full. Like slime-autodoc, but when called twice, or after slime-autodoc was already automatically called, display multiline arglist. --- /project/slime/cvsroot/slime/contrib/ChangeLog 2010/04/05 14:48:55 1.366 +++ /project/slime/cvsroot/slime/contrib/ChangeLog 2010/04/05 15:15:21 1.367 @@ -1,5 +1,13 @@ 2010-04-05 Stas Boukarev + * slime-autodoc.el (slime-autodoc-manually): Rename from + slime-autodoc-full. + Like slime-autodoc, but when called twice, + or after slime-autodoc was already automatically called, + display multiline arglist. + +2010-04-05 Stas Boukarev + * slime-autodoc.el (slime-autodoc-full): New command, displays multiline arglists. Bound to C-c C-d a. (slime-make-autodoc-rpc-form): Don't send --- /project/slime/cvsroot/slime/contrib/slime-autodoc.el 2010/04/05 14:48:55 1.41 +++ /project/slime/cvsroot/slime/contrib/slime-autodoc.el 2010/04/05 15:15:22 1.42 @@ -149,9 +149,9 @@ (multiple-value-bind (cache-key retrieve-form) (slime-make-autodoc-rpc-form) (let* (cached - (multiline-cached (slime-autodoc-cache-multine (car cache-key) - cache-multiline)) - (multilinep (or multilinep multiline-cached))) + (multilinep (or (slime-autodoc-multiline-cached (car cache-key)) + multilinep))) + (slime-autodoc-cache-multiline (car cache-key) cache-multiline) (cond ((not cache-key) nil) ((setq cached (slime-get-cached-autodoc cache-key)) @@ -174,20 +174,26 @@ (defvar slime-autodoc-cache-car nil) -(defun slime-autodoc-cache-multine (cache-key cache-new-p) +(defun slime-autodoc-multiline-cached (cache-key) + (equal cache-key + slime-autodoc-cache-car)) + +(defun slime-autodoc-cache-multiline (cache-key cache-new-p) (cond (cache-new-p (setq slime-autodoc-cache-car cache-key)) ((not (equal cache-key slime-autodoc-cache-car)) - (setq slime-autodoc-cache-car nil))) - (equal cache-key - slime-autodoc-cache-car)) + (setq slime-autodoc-cache-car nil)))) -(defun slime-autodoc-full () - "Like slime-autodoc, but with slime-autodoc-use-multiline-p enabled" +(defun slime-autodoc-manually () + "Like slime-autodoc, but when called twice, +or after slime-autodoc was already automatically called, +display multiline arglist" (interactive) - (eldoc-message (slime-autodoc t t))) + (eldoc-message (slime-autodoc (or slime-autodoc-use-multiline-p + slime-autodoc-mode) + t))) (make-variable-buffer-local (defvar slime-autodoc-mode nil)) @@ -215,7 +221,7 @@ ;; Display arglist only when inferior Lisp will be able ;; to cope with the request. (slime-background-activities-enabled-p))) - (slime-bind-keys slime-doc-map t '((?a slime-autodoc-full)))) + (slime-bind-keys slime-doc-map t '((?a slime-autodoc-manually)))) ad-return-value) From sboukarev at common-lisp.net Mon Apr 5 18:56:12 2010 From: sboukarev at common-lisp.net (CVS User sboukarev) Date: Mon, 05 Apr 2010 14:56:12 -0400 Subject: [slime-cvs] CVS slime Message-ID: Update of /project/slime/cvsroot/slime In directory cl-net:/tmp/cvs-serv23114 Modified Files: ChangeLog Log Message: * doc/slime.texi: Document the above change. --- /project/slime/cvsroot/slime/ChangeLog 2010/04/05 14:48:54 1.2055 +++ /project/slime/cvsroot/slime/ChangeLog 2010/04/05 18:56:12 1.2056 @@ -1,7 +1,9 @@ 2010-04-05 Stas Boukarev * slime.el (slime-doc-bindings): Move slime-apropos to C-c C-d A, - C-c C-d a will be bound to slime-autodoc-full. + C-c C-d a will be bound to slime-autodoc-manually. + + * doc/slime.texi: Document the above change. 2010-04-05 Stas Boukarev From sboukarev at common-lisp.net Mon Apr 5 18:56:13 2010 From: sboukarev at common-lisp.net (CVS User sboukarev) Date: Mon, 05 Apr 2010 14:56:13 -0400 Subject: [slime-cvs] CVS slime/doc Message-ID: Update of /project/slime/cvsroot/slime/doc In directory cl-net:/tmp/cvs-serv23114/doc Modified Files: slime.texi Log Message: * doc/slime.texi: Document the above change. --- /project/slime/cvsroot/slime/doc/slime.texi 2010/03/21 13:45:29 1.99 +++ /project/slime/cvsroot/slime/doc/slime.texi 2010/04/05 18:56:13 1.100 @@ -12,7 +12,7 @@ @set EDITION 3.0-alpha @set SLIMEVER 3.0-alpha @c @set UPDATED @today{} - at set UPDATED @code{$Date: 2010/03/21 13:45:29 $} + at set UPDATED @code{$Date: 2010/04/05 18:56:13 $} @set TITLE SLIME User Manual @settitle @value{TITLE}, version @value{EDITION} @@ -997,7 +997,7 @@ @kbditem{C-c C-d f, slime-describe-function} Describe the function at point. - at kbditem{C-c C-d a, slime-apropos} + at kbditem{C-c C-d A, slime-apropos} Perform an apropos search on Lisp symbol names for a regular expression match and display their documentation strings. By default the external symbols of all packages are searched. With a prefix argument you can choose a @@ -2554,12 +2554,21 @@ @cmditem{slime-autodoc-mode} Toggles autodoc-mode on or off according to the argument, and toggles the mode when invoked without argument. + at kbditem{C-c C-d a, slime-autodoc-manually} +Like slime-autodoc, but when called twice, +or after slime-autodoc was already automatically called, +display multiline arglist. @end table + at vindex slime-use-autodoc-mode If the variable @code{slime-use-autodoc-mode} is set (default), Emacs starts a timer, otherwise the information is only displayed after pressing SPC. + at vindex slime-autodoc-use-multiline-p +If @code{slime-autodoc-use-multiline-p} is set to non-nil, +allow long autodoc messages to resize echo area display. + @node ASDF @section ASDF From sboukarev at common-lisp.net Mon Apr 5 23:45:24 2010 From: sboukarev at common-lisp.net (CVS User sboukarev) Date: Mon, 05 Apr 2010 19:45:24 -0400 Subject: [slime-cvs] CVS slime/contrib Message-ID: Update of /project/slime/cvsroot/slime/contrib In directory cl-net:/tmp/cvs-serv24536 Modified Files: ChangeLog slime-autodoc.el slime-repl.el Log Message: * slime-repl.el (slime-repl-inside-string-or-comment-p): New function, when in the REPL prompt, narrow the search to the prompt, otherwise stray " from the previous prompts or outputs may confuse slime-inside-string-or-comment-p. * slime-autodoc.el (slime-autodoc): Use slime-repl-inside-string-or-comment-p when fbound. --- /project/slime/cvsroot/slime/contrib/ChangeLog 2010/04/05 15:15:21 1.367 +++ /project/slime/cvsroot/slime/contrib/ChangeLog 2010/04/05 23:45:23 1.368 @@ -1,5 +1,15 @@ 2010-04-05 Stas Boukarev + * slime-repl.el (slime-repl-inside-string-or-comment-p): New + function, when in the REPL prompt, narrow the search to the + prompt, otherwise stray " from the previous prompts + or outputs may confuse slime-inside-string-or-comment-p. + + * slime-autodoc.el (slime-autodoc): Use + slime-repl-inside-string-or-comment-p when fbound. + +2010-04-05 Stas Boukarev + * slime-autodoc.el (slime-autodoc-manually): Rename from slime-autodoc-full. Like slime-autodoc, but when called twice, --- /project/slime/cvsroot/slime/contrib/slime-autodoc.el 2010/04/05 15:15:22 1.42 +++ /project/slime/cvsroot/slime/contrib/slime-autodoc.el 2010/04/05 23:45:23 1.43 @@ -145,7 +145,9 @@ ;; background, so it'd be rather disastrous if it touched match ;; data. (save-match-data - (unless (slime-inside-string-or-comment-p) + (unless (if (fboundp 'slime-repl-inside-string-or-comment-p) + (slime-repl-inside-string-or-comment-p) + (slime-inside-string-or-comment-p)) (multiple-value-bind (cache-key retrieve-form) (slime-make-autodoc-rpc-form) (let* (cached --- /project/slime/cvsroot/slime/contrib/slime-repl.el 2010/03/09 14:10:37 1.39 +++ /project/slime/cvsroot/slime/contrib/slime-repl.el 2010/04/05 23:45:23 1.40 @@ -1540,6 +1540,14 @@ (let ((slime-dispatching-connection (slime-connection-at-point))) (switch-to-buffer (slime-output-buffer)))) +(defun slime-repl-inside-string-or-comment-p () + (save-restriction + (when (and (boundp 'slime-repl-input-start-mark) + slime-repl-input-start-mark + (>= (point) slime-repl-input-start-mark)) + (narrow-to-region slime-repl-input-start-mark (point))) + (slime-inside-string-or-comment-p))) + (defvar slime-repl-easy-menu (let ((C '(slime-connected-p))) `("REPL" From sboukarev at common-lisp.net Tue Apr 6 02:40:09 2010 From: sboukarev at common-lisp.net (CVS User sboukarev) Date: Mon, 05 Apr 2010 22:40:09 -0400 Subject: [slime-cvs] CVS slime/contrib Message-ID: Update of /project/slime/cvsroot/slime/contrib In directory cl-net:/tmp/cvs-serv15229 Modified Files: ChangeLog slime-sprof.el Log Message: * slime-sprof.el (slime-sprof-format): Remove references to the removed code. --- /project/slime/cvsroot/slime/contrib/ChangeLog 2010/04/05 23:45:23 1.368 +++ /project/slime/cvsroot/slime/contrib/ChangeLog 2010/04/06 02:40:09 1.369 @@ -1,3 +1,8 @@ +2010-04-06 Stas Boukarev + + * slime-sprof.el (slime-sprof-format): Remove references to the + removed code. + 2010-04-05 Stas Boukarev * slime-repl.el (slime-repl-inside-string-or-comment-p): New --- /project/slime/cvsroot/slime/contrib/slime-sprof.el 2010/04/05 10:53:02 1.6 +++ /project/slime/cvsroot/slime/contrib/slime-sprof.el 2010/04/06 02:40:09 1.7 @@ -44,7 +44,7 @@ ;; Reporting (defun slime-sprof-format (graph) - (with-current-buffer (slime-sprof-browser-buffer) + (with-current-buffer "*slime-sprof-browser*" (let ((inhibit-read-only t)) (erase-buffer) (insert (format "%4s %-54s %6s %6s %6s\n" From sboukarev at common-lisp.net Tue Apr 6 03:05:25 2010 From: sboukarev at common-lisp.net (CVS User sboukarev) Date: Mon, 05 Apr 2010 23:05:25 -0400 Subject: [slime-cvs] CVS slime Message-ID: Update of /project/slime/cvsroot/slime In directory cl-net:/tmp/cvs-serv3732 Modified Files: ChangeLog slime.el Log Message: * slime.el (slime-create-compilation-log): Enable compilation-mode, which was enabled previously by slime-insert-compilation-log. --- /project/slime/cvsroot/slime/ChangeLog 2010/04/05 18:56:12 1.2056 +++ /project/slime/cvsroot/slime/ChangeLog 2010/04/06 03:05:25 1.2057 @@ -1,3 +1,9 @@ +2010-04-06 Stas Boukarev + + * slime.el (slime-create-compilation-log): Enable + compilation-mode, which was enabled previously by + slime-insert-compilation-log. + 2010-04-05 Stas Boukarev * slime.el (slime-doc-bindings): Move slime-apropos to C-c C-d A, --- /project/slime/cvsroot/slime/slime.el 2010/04/05 14:48:54 1.1296 +++ /project/slime/cvsroot/slime/slime.el 2010/04/06 03:05:25 1.1297 @@ -2775,7 +2775,8 @@ (with-current-buffer (get-buffer-create "*SLIME Compilation*") (let ((inhibit-read-only t)) (erase-buffer)) - (slime-insert-compilation-log notes))) + (slime-insert-compilation-log notes) + (compilation-mode))) (defun slime-maybe-show-compilation-log (notes) "Display the log on failed compilations or if NOTES is non-nil." From sboukarev at common-lisp.net Tue Apr 6 13:24:29 2010 From: sboukarev at common-lisp.net (CVS User sboukarev) Date: Tue, 06 Apr 2010 09:24:29 -0400 Subject: [slime-cvs] CVS slime/contrib Message-ID: Update of /project/slime/cvsroot/slime/contrib In directory cl-net:/tmp/cvs-serv19463 Modified Files: ChangeLog slime-c-p-c.el Log Message: * slime-c-p-c.el (slime-complete-symbol*-fancy-bit): There is no slime-space-information-p variable anymore. Patch by Steven H. Margolis. --- /project/slime/cvsroot/slime/contrib/ChangeLog 2010/04/06 02:40:09 1.369 +++ /project/slime/cvsroot/slime/contrib/ChangeLog 2010/04/06 13:24:29 1.370 @@ -1,5 +1,11 @@ 2010-04-06 Stas Boukarev + * slime-c-p-c.el (slime-complete-symbol*-fancy-bit): There is no + slime-space-information-p variable anymore. + Patch by Steven H. Margolis. + +2010-04-06 Stas Boukarev + * slime-sprof.el (slime-sprof-format): Remove references to the removed code. --- /project/slime/cvsroot/slime/contrib/slime-c-p-c.el 2010/03/20 08:27:50 1.22 +++ /project/slime/cvsroot/slime/contrib/slime-c-p-c.el 2010/04/06 13:24:29 1.23 @@ -92,16 +92,15 @@ (cdr (read arglist)))) (function-call-position-p (save-excursion - (backward-sexp) - (equal (char-before) ?\()))) + (backward-sexp) + (equal (char-before) ?\()))) (when function-call-position-p (if (null args) (insert-and-inherit ")") - (insert-and-inherit " ") - (when (and slime-space-information-p - (slime-background-activities-enabled-p) - (not (minibuffer-window-active-p (minibuffer-window)))) - (slime-echo-arglist)))))))) + (insert-and-inherit " ") + (when (and (slime-background-activities-enabled-p) + (not (minibuffer-window-active-p (minibuffer-window)))) + (slime-echo-arglist)))))))) (defun* slime-contextual-completions (beg end) "Return a list of completions of the token from BEG to END in the From heller at common-lisp.net Mon Apr 12 18:38:51 2010 From: heller at common-lisp.net (CVS User heller) Date: Mon, 12 Apr 2010 14:38:51 -0400 Subject: [slime-cvs] CVS slime Message-ID: Update of /project/slime/cvsroot/slime In directory cl-net:/tmp/cvs-serv4379 Modified Files: ChangeLog slime.el Log Message: Fix compile-file for various backends. * slime.el (slime-compile-file): Only pass non-nil keyword args to Lisp. (slime-simplify-plist): New helper. (slime-compile-and-load-file): Pass policy parameter directly without using global variables. * swank.lisp (compile-file-for-emacs): Change singature sightly. --- /project/slime/cvsroot/slime/ChangeLog 2010/04/06 03:05:25 1.2057 +++ /project/slime/cvsroot/slime/ChangeLog 2010/04/12 18:38:51 1.2058 @@ -4,6 +4,18 @@ compilation-mode, which was enabled previously by slime-insert-compilation-log. +2010-04-12 Helmut Eller + + Fix compile-file for various backends. + + * slime.el (slime-compile-file): Only pass non-nil keyword args to + Lisp. + (slime-simplify-plist): New helper. + (slime-compile-and-load-file): Pass policy parameter directly + without using global variables. + + * swank.lisp (compile-file-for-emacs): Change singature sightly. + 2010-04-05 Stas Boukarev * slime.el (slime-doc-bindings): Move slime-apropos to C-c C-d A, --- /project/slime/cvsroot/slime/slime.el 2010/04/06 03:05:25 1.1297 +++ /project/slime/cvsroot/slime/slime.el 2010/04/12 18:38:51 1.1298 @@ -2561,15 +2561,14 @@ `slime-next-note' and `slime-previous-note' can be used to navigate between compiler notes and to display their full details." (interactive "P") - (let ((slime-compilation-policy (slime-compute-policy policy))) - (slime-compile-file t))) + (slime-compile-file t (slime-compute-policy policy))) ;;; FIXME: This should become a DEFCUSTOM (defvar slime-compile-file-options '() "Plist of additional options that C-c C-k should pass to Lisp. Currently only :fasl-directory is supported.") -(defun slime-compile-file (&optional load) +(defun slime-compile-file (&optional load policy) "Compile current buffer's file and highlight resulting compiler notes. See `slime-compile-and-load-file' for further details." @@ -2581,14 +2580,19 @@ (y-or-n-p (format "Save file %s? " (buffer-file-name)))) (save-buffer)) (run-hook-with-args 'slime-before-compile-functions (point-min) (point-max)) - (let ((file (slime-to-lisp-filename (buffer-file-name)))) + (let ((file (slime-to-lisp-filename (buffer-file-name))) + (options (slime-simplify-plist `(, at slime-compile-file-options + :policy ,policy)))) (slime-eval-async - `(swank:compile-file-for-emacs ,file ,(if load t nil) - :options ',slime-compile-file-options - :policy ',slime-compilation-policy) - #'slime-compilation-finished) + `(swank:compile-file-for-emacs ,file ,(if load t nil) . ,options) + #'slime-compilation-finished) (message "Compiling %s..." file))) +(defun slime-simplify-plist (plist) + (loop for (key val) on plist by #'cddr + append (cond ((null val) '()) + (t (list key val))))) + (defun slime-compile-defun (&optional raw-prefix-arg) "Compile the current toplevel form. From heller at common-lisp.net Mon Apr 12 18:50:50 2010 From: heller at common-lisp.net (CVS User heller) Date: Mon, 12 Apr 2010 14:50:50 -0400 Subject: [slime-cvs] CVS slime Message-ID: Update of /project/slime/cvsroot/slime In directory cl-net:/tmp/cvs-serv17100 Modified Files: ChangeLog Log Message: *** empty log message *** --- /project/slime/cvsroot/slime/ChangeLog 2010/04/12 18:38:51 1.2058 +++ /project/slime/cvsroot/slime/ChangeLog 2010/04/12 18:50:50 1.2059 @@ -1,9 +1,3 @@ -2010-04-06 Stas Boukarev - - * slime.el (slime-create-compilation-log): Enable - compilation-mode, which was enabled previously by - slime-insert-compilation-log. - 2010-04-12 Helmut Eller Fix compile-file for various backends. @@ -16,6 +10,12 @@ * swank.lisp (compile-file-for-emacs): Change singature sightly. +2010-04-06 Stas Boukarev + + * slime.el (slime-create-compilation-log): Enable + compilation-mode, which was enabled previously by + slime-insert-compilation-log. + 2010-04-05 Stas Boukarev * slime.el (slime-doc-bindings): Move slime-apropos to C-c C-d A, From heller at common-lisp.net Mon Apr 12 18:51:03 2010 From: heller at common-lisp.net (CVS User heller) Date: Mon, 12 Apr 2010 14:51:03 -0400 Subject: [slime-cvs] CVS slime/contrib Message-ID: Update of /project/slime/cvsroot/slime/contrib In directory cl-net:/tmp/cvs-serv17587/contrib Modified Files: slime-autodoc.el Log Message: * slime.el (slime-doc-bindings): Restore key for slime-apropos. --- /project/slime/cvsroot/slime/contrib/slime-autodoc.el 2010/04/05 23:45:23 1.43 +++ /project/slime/cvsroot/slime/contrib/slime-autodoc.el 2010/04/12 18:51:02 1.44 @@ -223,7 +223,7 @@ ;; Display arglist only when inferior Lisp will be able ;; to cope with the request. (slime-background-activities-enabled-p))) - (slime-bind-keys slime-doc-map t '((?a slime-autodoc-manually)))) + (slime-bind-keys slime-doc-map t '((?A slime-autodoc-manually)))) ad-return-value) From heller at common-lisp.net Mon Apr 12 18:51:01 2010 From: heller at common-lisp.net (CVS User heller) Date: Mon, 12 Apr 2010 14:51:01 -0400 Subject: [slime-cvs] CVS slime Message-ID: Update of /project/slime/cvsroot/slime In directory cl-net:/tmp/cvs-serv17587 Modified Files: ChangeLog slime.el Log Message: * slime.el (slime-doc-bindings): Restore key for slime-apropos. --- /project/slime/cvsroot/slime/ChangeLog 2010/04/12 18:50:50 1.2059 +++ /project/slime/cvsroot/slime/ChangeLog 2010/04/12 18:51:00 1.2060 @@ -16,6 +16,10 @@ compilation-mode, which was enabled previously by slime-insert-compilation-log. +2010-04-12 Helmut Eller + + * slime.el (slime-doc-bindings): Restore key for slime-apropos. + 2010-04-05 Stas Boukarev * slime.el (slime-doc-bindings): Move slime-apropos to C-c C-d A, --- /project/slime/cvsroot/slime/slime.el 2010/04/12 18:38:51 1.1298 +++ /project/slime/cvsroot/slime/slime.el 2010/04/12 18:51:01 1.1299 @@ -564,7 +564,7 @@ "Keymap for documentation commands. Bound to a prefix key.") (defvar slime-doc-bindings - '((?A slime-apropos) + '((?a slime-apropos) (?z slime-apropos-all) (?p slime-apropos-package) (?d slime-describe-symbol) From heller at common-lisp.net Mon Apr 12 18:51:10 2010 From: heller at common-lisp.net (CVS User heller) Date: Mon, 12 Apr 2010 14:51:10 -0400 Subject: [slime-cvs] CVS slime Message-ID: Update of /project/slime/cvsroot/slime In directory cl-net:/tmp/cvs-serv17890 Modified Files: ChangeLog Log Message: *** empty log message *** --- /project/slime/cvsroot/slime/ChangeLog 2010/04/12 18:51:00 1.2060 +++ /project/slime/cvsroot/slime/ChangeLog 2010/04/12 18:51:10 1.2061 @@ -1,5 +1,9 @@ 2010-04-12 Helmut Eller + * slime.el (slime-doc-bindings): Restore key for slime-apropos. + +2010-04-12 Helmut Eller + Fix compile-file for various backends. * slime.el (slime-compile-file): Only pass non-nil keyword args to @@ -16,10 +20,6 @@ compilation-mode, which was enabled previously by slime-insert-compilation-log. -2010-04-12 Helmut Eller - - * slime.el (slime-doc-bindings): Restore key for slime-apropos. - 2010-04-05 Stas Boukarev * slime.el (slime-doc-bindings): Move slime-apropos to C-c C-d A, From heller at common-lisp.net Wed Apr 14 17:51:30 2010 From: heller at common-lisp.net (CVS User heller) Date: Wed, 14 Apr 2010 13:51:30 -0400 Subject: [slime-cvs] CVS slime Message-ID: Update of /project/slime/cvsroot/slime In directory cl-net:/tmp/cvs-serv9765 Modified Files: ChangeLog swank-rpc.lisp swank.lisp Log Message: Move error handling and logging from swank-rpc.lisp to swank.lisp * swank.lisp (log-event, destructure-case, decode-message) (encode-message, decode-message, swank-protocol-error): Moved back to swank.lisp from swank-rpc.lisp. It never belonged there anyway. * swank-rpc.lisp (read-message, write-message): New functions. (swank-reader-error): New condition. --- /project/slime/cvsroot/slime/ChangeLog 2010/04/12 18:51:10 1.2061 +++ /project/slime/cvsroot/slime/ChangeLog 2010/04/14 17:51:30 1.2062 @@ -1,3 +1,15 @@ +2010-04-14 Helmut Eller + + Move error handling and logging from swank-rpc.lisp to swank.lisp + + * swank.lisp (log-event, destructure-case, decode-message) + (encode-message, decode-message, swank-protocol-error): Moved back + to swank.lisp from swank-rpc.lisp. It never belonged there + anyway. + + * swank-rpc.lisp (read-message, write-message): New functions. + (swank-reader-error): New condition. + 2010-04-12 Helmut Eller * slime.el (slime-doc-bindings): Restore key for slime-apropos. --- /project/slime/cvsroot/slime/swank-rpc.lisp 2010/01/27 06:38:27 1.5 +++ /project/slime/cvsroot/slime/swank-rpc.lisp 2010/04/14 17:51:30 1.6 @@ -8,44 +8,62 @@ ;;; are disclaimed. ;;; -(defpackage :swank-rpc +(defpackage #:swank-rpc (:use :cl) (:export - ; export everything for compatibility, need to be trimmed down! - #:decode-message - #:read-packet - #:read-chunk - #:*swank-io-package* - #:read-form - #:encode-message - #:prin1-to-string-for-emacs - #:destructure-case - #:swank-protocol-error - #:swank-protocol-error.condition - #:make-swank-protocol-error - #:*log-events* - #:*log-output* - #:init-log-output - #:real-input-stream - #:real-output-stream - #:*event-history* - #:*event-history-index* - #:*enable-event-history* - #:log-event - #:event-history-to-list - #:clear-event-history - #:dump-event-history - #:dump-event - #:escape-non-ascii - #:ascii-string-p - #:ascii-char-p)) + #:read-message + #:swank-reader-error + #:swank-reader-error.packet + #:swank-reader-error.cause + #:write-message)) (in-package :swank-rpc) + ;;;;; Input +(define-condition swank-reader-error (reader-error) + ((packet :type string :initarg :packet :reader swank-reader-error.packet) + (cause :type reader-error :initarg :cause :reader swank-reader-error.cause))) + +(defun read-message (stream package) + (let ((packet (read-packet stream))) + (handler-case (values (read-form packet package)) + (reader-error (c) + (error (make-condition 'swank-reader-error :packet packet :cause c)))))) + +;; use peek-char to detect EOF, read-sequence may return 0 instead of +;; signaling a condition. +(defun read-packet (stream) + (peek-char nil stream) + (let* ((header (read-chunk stream 6)) + (length (parse-integer header :radix #x10)) + (payload (read-chunk stream length))) + payload)) + +(defun read-chunk (stream length) + (let* ((buffer (make-string length)) + (count (read-sequence buffer stream))) + (assert (= count length) () "Short read: length=~D count=~D" length count) + buffer)) + +;; FIXME: no one ever tested this and will probably not work. +(defparameter *validate-input* nil + "Set to true to require input that strictly conforms to the protocol") + +(defun read-form (string package) + (with-standard-io-syntax + (let ((*package* package)) + (if *validate-input* + (validating-read string) + (read-from-string string))))) + +(defun validating-read (string) + (with-input-from-string (*standard-input* string) + (simple-read))) + (defun simple-read () - "Reads a form that conforms to the protocol, otherwise signalling an error." + "Read a form that conforms to the protocol, otherwise signal an error." (let ((c (read-char))) (case c (#\" (with-output-to-string (*standard-output*) @@ -69,204 +87,38 @@ (cond ((digit-char-p c) (parse-integer string)) ((intern string)))))))) -(defun decode-message (stream) - "Read an S-expression from STREAM using the SLIME protocol." - ;;(log-event "decode-message~%") - (handler-bind ((error (lambda (c) (error (make-swank-protocol-error c))))) - (let ((packet (read-packet stream))) - (handler-case (values (read-form packet) nil) - (reader-error (c) - `(:reader-error ,packet ,c)))))) - -;; use peek-char to detect EOF, read-sequence may return 0 instead of -;; signaling a condition. -(defun read-packet (stream) - (peek-char nil stream) - (let* ((header (read-chunk stream 6)) - (length (parse-integer header :radix #x10)) - (payload (read-chunk stream length))) - (log-event "READ: ~S~%" payload) - payload)) - -(defun read-chunk (stream length) - (let* ((buffer (make-string length)) - (count (read-sequence buffer stream))) - (assert (= count length) () "Short read: length=~D count=~D" length count) - buffer)) - -(defvar *swank-io-package* - (let ((package (make-package :swank-io-package :use '()))) - (import '(nil t quote) package) - package)) - -(defparameter *validate-input* nil - "Set to true to require input that strictly conforms to the protocol") - -(defun read-form (string) - (with-standard-io-syntax - (let ((*package* *swank-io-package*)) - (if *validate-input* - (with-input-from-string (*standard-input* string) - (simple-read)) - (read-from-string string))))) - + ;;;;; Output -(defun encode-message (message stream) - (handler-bind ((error (lambda (c) (error (make-swank-protocol-error c))))) - (let* ((string (prin1-to-string-for-emacs message)) - (length (length string))) - (log-event "WRITE: ~A~%" string) - (let ((*print-pretty* nil)) - (format stream "~6,'0x" length)) - (write-string string stream) - (finish-output stream)))) +(defun write-message (message package stream) + (let* ((string (prin1-to-string-for-emacs message package)) + (length (length string))) + (let ((*print-pretty* nil)) + (format stream "~6,'0x" length)) + (write-string string stream) + (finish-output stream))) -(defun prin1-to-string-for-emacs (object) +(defun prin1-to-string-for-emacs (object package) (with-standard-io-syntax (let ((*print-case* :downcase) (*print-readably* nil) (*print-pretty* nil) - (*package* *swank-io-package*)) + (*package* package)) (prin1-to-string object)))) -;;;;; message decomposition - -(defmacro destructure-case (value &rest patterns) - "Dispatch VALUE to one of PATTERNS. -A cross between `case' and `destructuring-bind'. -The pattern syntax is: - ((HEAD . ARGS) . BODY) -The list of patterns is searched for a HEAD `eq' to the car of -VALUE. If one is found, the BODY is executed with ARGS bound to the -corresponding values in the CDR of VALUE." - (let ((operator (gensym "op-")) - (operands (gensym "rand-")) - (tmp (gensym "tmp-"))) - `(let* ((,tmp ,value) - (,operator (car ,tmp)) - (,operands (cdr ,tmp))) - (case ,operator - ,@(loop for (pattern . body) in patterns collect - (if (eq pattern t) - `(t , at body) - (destructuring-bind (op &rest rands) pattern - `(,op (destructuring-bind ,rands ,operands - , at body))))) - ,@(if (eq (caar (last patterns)) t) - '() - `((t (error "destructure-case failed: ~S" ,tmp)))))))) - -;;;;; Error handling - -(define-condition swank-protocol-error (error) - ((condition :initarg :condition :reader swank-protocol-error.condition)) - (:report (lambda (condition stream) - (princ (swank-protocol-error.condition condition) stream)))) - -(defun make-swank-protocol-error (condition) - (make-condition 'swank-protocol-error :condition condition)) - -;;;;; Logging - -(defvar *log-events* nil) -(defvar *log-output* nil) ; should be nil for image dumpers - -(defun init-log-output () - (unless *log-output* - (setq *log-output* (real-output-stream *error-output*)))) - -(defun real-input-stream (stream) - (typecase stream - (synonym-stream - (real-input-stream (symbol-value (synonym-stream-symbol stream)))) - (two-way-stream - (real-input-stream (two-way-stream-input-stream stream))) - (t stream))) - -(defun real-output-stream (stream) - (typecase stream - (synonym-stream - (real-output-stream (symbol-value (synonym-stream-symbol stream)))) - (two-way-stream - (real-output-stream (two-way-stream-output-stream stream))) - (t stream))) - -(defvar *event-history* (make-array 40 :initial-element nil) - "A ring buffer to record events for better error messages.") -(defvar *event-history-index* 0) -(defvar *enable-event-history* t) - -(defun log-event (format-string &rest args) - "Write a message to *terminal-io* when *log-events* is non-nil. -Useful for low level debugging." - (with-standard-io-syntax - (let ((*print-readably* nil) - (*print-pretty* nil) - (*package* *swank-io-package*)) - (when *enable-event-history* - (setf (aref *event-history* *event-history-index*) - (format nil "~?" format-string args)) - (setf *event-history-index* - (mod (1+ *event-history-index*) (length *event-history*)))) - (when *log-events* - (write-string (escape-non-ascii (format nil "~?" format-string args)) - *log-output*) - (force-output *log-output*))))) - -(defun event-history-to-list () - "Return the list of events (older events first)." - (let ((arr *event-history*) - (idx *event-history-index*)) - (concatenate 'list (subseq arr idx) (subseq arr 0 idx)))) - -(defun clear-event-history () - (fill *event-history* nil) - (setq *event-history-index* 0)) - -(defun dump-event-history (stream) - (dolist (e (event-history-to-list)) - (dump-event e stream))) - -(defun dump-event (event stream) - (cond ((stringp event) - (write-string (escape-non-ascii event) stream)) - ((null event)) - (t - (write-string - (escape-non-ascii (format nil "Unexpected event: ~A~%" event)) - stream)))) - -(defun escape-non-ascii (string) - "Return a string like STRING but with non-ascii chars escaped." - (cond ((ascii-string-p string) string) - (t (with-output-to-string (out) - (loop for c across string do - (cond ((ascii-char-p c) (write-char c out)) - (t (format out "\\x~4,'0X" (char-code c))))))))) - -(defun ascii-string-p (o) - (and (stringp o) - (every #'ascii-char-p o))) - -(defun ascii-char-p (c) - (<= (char-code c) 127)) - - + #| TEST/DEMO: -(setf *log-events* T) - (defparameter *transport* (with-output-to-string (out) - (encode-message '(:message (hello "world")) out) - (encode-message '(:return 5) out) - (encode-message '(:emacs-rex NIL) out))) + (write-message '(:message (hello "world")) *package* out) + (write-message '(:return 5) *package* out) + (write-message '(:emacs-rex NIL) *package* out))) *transport* (with-input-from-string (in *transport*) (loop while (peek-char T in NIL) - collect (decode-message in))) + collect (read-message in *package*))) |# --- /project/slime/cvsroot/slime/swank.lisp 2010/03/29 15:57:28 1.707 +++ /project/slime/cvsroot/slime/swank.lisp 2010/04/14 17:51:30 1.708 @@ -354,6 +354,14 @@ (call-with-debugging-environment (lambda () (backtrace 0 nil))))) +(define-condition swank-protocol-error (error) + ((condition :initarg :condition :reader swank-protocol-error.condition)) + (:report (lambda (condition stream) + (princ (swank-protocol-error.condition condition) stream)))) + +(defun make-swank-protocol-error (condition) + (make-condition 'swank-protocol-error :condition condition)) + (defvar *debug-on-swank-protocol-error* nil "When non-nil invoke the system debugger on errors that were signalled during decoding/encoding the wire protocol. Do not set this @@ -392,8 +400,125 @@ ;;;; Utilities + +;;;;; Logging + +(defvar *swank-io-package* + (let ((package (make-package :swank-io-package :use '()))) + (import '(nil t quote) package) + package)) + +(defvar *log-events* nil) +(defvar *log-output* nil) ; should be nil for image dumpers + +(defun init-log-output () + (unless *log-output* + (setq *log-output* (real-output-stream *error-output*)))) + +(defun real-input-stream (stream) + (typecase stream + (synonym-stream + (real-input-stream (symbol-value (synonym-stream-symbol stream)))) + (two-way-stream + (real-input-stream (two-way-stream-input-stream stream))) + (t stream))) + +(defun real-output-stream (stream) + (typecase stream + (synonym-stream + (real-output-stream (symbol-value (synonym-stream-symbol stream)))) + (two-way-stream + (real-output-stream (two-way-stream-output-stream stream))) + (t stream))) + +(defvar *event-history* (make-array 40 :initial-element nil) + "A ring buffer to record events for better error messages.") +(defvar *event-history-index* 0) +(defvar *enable-event-history* t) + +(defun log-event (format-string &rest args) + "Write a message to *terminal-io* when *log-events* is non-nil. +Useful for low level debugging." + (with-standard-io-syntax + (let ((*print-readably* nil) + (*print-pretty* nil) + (*package* *swank-io-package*)) + (when *enable-event-history* + (setf (aref *event-history* *event-history-index*) + (format nil "~?" format-string args)) + (setf *event-history-index* + (mod (1+ *event-history-index*) (length *event-history*)))) + (when *log-events* + (write-string (escape-non-ascii (format nil "~?" format-string args)) + *log-output*) + (force-output *log-output*))))) + +(defun event-history-to-list () + "Return the list of events (older events first)." + (let ((arr *event-history*) + (idx *event-history-index*)) + (concatenate 'list (subseq arr idx) (subseq arr 0 idx)))) + +(defun clear-event-history () + (fill *event-history* nil) + (setq *event-history-index* 0)) + +(defun dump-event-history (stream) + (dolist (e (event-history-to-list)) + (dump-event e stream))) + +(defun dump-event (event stream) + (cond ((stringp event) + (write-string (escape-non-ascii event) stream)) + ((null event)) + (t + (write-string + (escape-non-ascii (format nil "Unexpected event: ~A~%" event)) + stream)))) + +(defun escape-non-ascii (string) + "Return a string like STRING but with non-ascii chars escaped." + (cond ((ascii-string-p string) string) + (t (with-output-to-string (out) + (loop for c across string do + (cond ((ascii-char-p c) (write-char c out)) + (t (format out "\\x~4,'0X" (char-code c))))))))) + +(defun ascii-string-p (o) + (and (stringp o) + (every #'ascii-char-p o))) + +(defun ascii-char-p (c) + (<= (char-code c) 127)) + + ;;;;; Helper macros +(defmacro destructure-case (value &rest patterns) + "Dispatch VALUE to one of PATTERNS. +A cross between `case' and `destructuring-bind'. +The pattern syntax is: + ((HEAD . ARGS) . BODY) +The list of patterns is searched for a HEAD `eq' to the car of +VALUE. If one is found, the BODY is executed with ARGS bound to the +corresponding values in the CDR of VALUE." + (let ((operator (gensym "op-")) + (operands (gensym "rand-")) + (tmp (gensym "tmp-"))) + `(let* ((,tmp ,value) + (,operator (car ,tmp)) + (,operands (cdr ,tmp))) + (case ,operator + ,@(loop for (pattern . body) in patterns collect + (if (eq pattern t) + `(t , at body) + (destructuring-bind (op &rest rands) pattern + `(,op (destructuring-bind ,rands ,operands + , at body))))) + ,@(if (eq (caar (last patterns)) t) + '() + `((t (error "destructure-case failed: ~S" ,tmp)))))))) + ;; If true execute interrupts, otherwise queue them. ;; Note: `with-connection' binds *pending-slime-interrupts*. (defvar *slime-interrupts-enabled*) @@ -872,6 +997,28 @@ (when socket (close-socket socket))))) + +;;;;; Event Decoding/Encoding + +(defun decode-message (stream) + "Read an S-expression from STREAM using the SLIME protocol." + (log-event "decode-message~%") + (without-slime-interrupts + (handler-bind ((error (lambda (c) (error (make-swank-protocol-error c))))) + (handler-case (read-message stream *swank-io-package*) + (swank-reader-error (c) + `(:reader-error ,(swank-reader-error.packet c) + ,(swank-reader-error.cause c))))))) + +(defun encode-message (message stream) + "Write an S-expression to STREAM using the SLIME protocol." + (log-event "encode-message~%") + (without-slime-interrupts + (handler-bind ((error (lambda (c) (error (make-swank-protocol-error c))))) + (write-message message *swank-io-package* stream)))) + + +;;;;; Event Processing ;; By default, this restart will be named "abort" because many people ;; press "a" instead of "q" in the debugger. (define-special *sldb-quit-restart* From heller at common-lisp.net Wed Apr 14 17:51:38 2010 From: heller at common-lisp.net (CVS User heller) Date: Wed, 14 Apr 2010 13:51:38 -0400 Subject: [slime-cvs] CVS slime Message-ID: Update of /project/slime/cvsroot/slime In directory cl-net:/tmp/cvs-serv9817 Modified Files: ChangeLog swank.lisp Log Message: Handle errors during interrupt processing with SLDB. Bugfix for http://article.gmane.org/gmane.lisp.slime.devel/9641 * swank.lisp (invoke-or-queue-interrupt): When the queue is full, process the interrupt immediately and also handle SERIOUS-CONDITIONs during interrupt processing in SLDB. SLDB should work more likely than the interrupted code is expected to handle the condition. (with-interrupts-enabled%): Don't check for interrupts when toggling interrupts off. (wait-for-event): Add docstring. --- /project/slime/cvsroot/slime/ChangeLog 2010/04/14 17:51:30 1.2062 +++ /project/slime/cvsroot/slime/ChangeLog 2010/04/14 17:51:38 1.2063 @@ -1,5 +1,19 @@ 2010-04-14 Helmut Eller + Handle errors during interrupt processing with SLDB. + Bugfix for http://article.gmane.org/gmane.lisp.slime.devel/9641 + + * swank.lisp (invoke-or-queue-interrupt): When the queue is full, + process the interrupt immediately and also handle + SERIOUS-CONDITIONs during interrupt processing in SLDB. SLDB + should work more likely than the interrupted code is expected to + handle the condition. + (with-interrupts-enabled%): Don't check for interrupts when + toggling interrupts off. + (wait-for-event): Add docstring. + +2010-04-14 Helmut Eller + Move error handling and logging from swank-rpc.lisp to swank.lisp * swank.lisp (log-event, destructure-case, decode-message) --- /project/slime/cvsroot/slime/swank.lisp 2010/04/14 17:51:30 1.708 +++ /project/slime/cvsroot/slime/swank.lisp 2010/04/14 17:51:38 1.709 @@ -525,11 +525,11 @@ (defmacro with-interrupts-enabled% (flag body) `(progn - (check-slime-interrupts) + ,@(if flag '((check-slime-interrupts))) (multiple-value-prog1 (let ((*slime-interrupts-enabled* ,flag)) , at body) - (check-slime-interrupts)))) + ,@(if flag '((check-slime-interrupts)))))) (defmacro with-slime-interrupts (&body body) `(with-interrupts-enabled% t ,body)) @@ -551,9 +551,11 @@ (list function))) (cond ((cdr *pending-slime-interrupts*) (log-event "too many queued interrupts~%") - (check-slime-interrupts)) + (with-simple-restart (continue "Continue from interrupt") + (handler-bind ((serious-condition #'invoke-slime-debugger)) + (check-slime-interrupts)))) (t - (log-event "queue-interrupt: ~a" function) + (log-event "queue-interrupt: ~a~%" function) (when *interrupt-queued-handler* (funcall *interrupt-queued-handler*))))))) @@ -1261,6 +1263,11 @@ (t (dispatch-event event)))) (defun wait-for-event (pattern &optional timeout) + "Scan the event queue for PATTERN and return the event. +If TIMEOUT is 'nil wait until a matching event is enqued. +If TIMEOUT is 't only scan the queue without waiting. +The second return value is t if the timeout expired before a matching +event was found." (log-event "wait-for-event: ~s ~s~%" pattern timeout) (without-slime-interrupts (cond ((use-threads-p) From heller at common-lisp.net Wed Apr 14 17:51:47 2010 From: heller at common-lisp.net (CVS User heller) Date: Wed, 14 Apr 2010 13:51:47 -0400 Subject: [slime-cvs] CVS slime Message-ID: Update of /project/slime/cvsroot/slime In directory cl-net:/tmp/cvs-serv9889 Modified Files: ChangeLog slime.el Log Message: * slime.el ([test] interrupt-encode-message): New test. --- /project/slime/cvsroot/slime/ChangeLog 2010/04/14 17:51:38 1.2063 +++ /project/slime/cvsroot/slime/ChangeLog 2010/04/14 17:51:47 1.2064 @@ -1,5 +1,9 @@ 2010-04-14 Helmut Eller + * slime.el ([test] interrupt-encode-message): New test. + +2010-04-14 Helmut Eller + Handle errors during interrupt processing with SLDB. Bugfix for http://article.gmane.org/gmane.lisp.slime.devel/9641 --- /project/slime/cvsroot/slime/slime.el 2010/04/12 18:51:01 1.1299 +++ /project/slime/cvsroot/slime/slime.el 2010/04/14 17:51:47 1.1300 @@ -8012,6 +8012,23 @@ (sldb-quit)) (slime-sync-to-top-level 5)) +(def-slime-test (interrupt-encode-message (:style :sigio)) + () + "Test interrupt processing during swank::encode-message" + '(()) + (slime-eval-async '(cl:loop :for i :from 0 + :do (swank::background-message "foo ~d" i))) + (sleep-for 1) + (slime-eval-async '(cl:/ 1 0)) + (slime-wait-condition "Debugger visible" + (lambda () + (and (slime-sldb-level= 1) + (get-buffer-window (sldb-get-default-buffer)))) + 30) + (with-current-buffer (sldb-get-default-buffer) + (sldb-quit)) + (slime-sync-to-top-level 5)) + (def-slime-test inspector (exp) "Test basic inspector workingness." From heller at common-lisp.net Wed Apr 14 17:51:56 2010 From: heller at common-lisp.net (CVS User heller) Date: Wed, 14 Apr 2010 13:51:56 -0400 Subject: [slime-cvs] CVS slime Message-ID: Update of /project/slime/cvsroot/slime In directory cl-net:/tmp/cvs-serv10316 Modified Files: ChangeLog swank.lisp Log Message: * swank.lisp (compile-file-for-emacs): Actually commit the change described in 2010-04-12. --- /project/slime/cvsroot/slime/ChangeLog 2010/04/14 17:51:47 1.2064 +++ /project/slime/cvsroot/slime/ChangeLog 2010/04/14 17:51:56 1.2065 @@ -1,5 +1,10 @@ 2010-04-14 Helmut Eller + * swank.lisp (compile-file-for-emacs): Actually commit the change + described in 2010-04-12. + +2010-04-14 Helmut Eller + * slime.el ([test] interrupt-encode-message): New test. 2010-04-14 Helmut Eller --- /project/slime/cvsroot/slime/swank.lisp 2010/04/14 17:51:38 1.709 +++ /project/slime/cvsroot/slime/swank.lisp 2010/04/14 17:51:56 1.710 @@ -2813,7 +2813,8 @@ (funcall function))))) (make-compilation-result (reverse notes) (and successp t) seconds)))) -(defslimefun compile-file-for-emacs (filename load-p &key options policy) +(defslimefun compile-file-for-emacs (filename load-p &rest options &key policy + &allow-other-keys) "Compile FILENAME and, when LOAD-P, load the result. Record compiler notes signalled as `compiler-condition's." (with-buffer-syntax () From trittweiler at common-lisp.net Thu Apr 15 18:01:14 2010 From: trittweiler at common-lisp.net (CVS User trittweiler) Date: Thu, 15 Apr 2010 14:01:14 -0400 Subject: [slime-cvs] CVS slime Message-ID: Update of /project/slime/cvsroot/slime In directory cl-net:/tmp/cvs-serv17653 Modified Files: ChangeLog slime.el Log Message: * slime.el (sldb-mode): Include some more commands in its help. (sldb-goto-last-frame): Do not center to the middle but to the bottom of the window. --- /project/slime/cvsroot/slime/ChangeLog 2010/04/14 17:51:56 1.2065 +++ /project/slime/cvsroot/slime/ChangeLog 2010/04/15 18:01:13 1.2066 @@ -1,3 +1,9 @@ +2010-04-15 Tobias C. Rittweiler + + * slime.el (sldb-mode): Include some more commands in its help. + (sldb-goto-last-frame): Do not center to the middle but to the + bottom of the window. + 2010-04-14 Helmut Eller * swank.lisp (compile-file-for-emacs): Actually commit the change --- /project/slime/cvsroot/slime/slime.el 2010/04/14 17:51:47 1.1300 +++ /project/slime/cvsroot/slime/slime.el 2010/04/15 18:01:13 1.1301 @@ -5341,19 +5341,25 @@ \\[sldb-abort] - abort \\[sldb-continue] - continue \\[sldb-invoke-restart-0]-\\[sldb-invoke-restart-9] - restart shortcuts + \\[sldb-invoke-restart-by-name] - invoke restart by name Commands to navigate frames: \\[sldb-down] - down \\[sldb-up] - up \\[sldb-details-down] - down, with details \\[sldb-details-up] - up, with details + \\[sldb-cycle] - cycle between restarts & backtrace + \\[sldb-beginning-of-backtrace] - beginning of backtrace + \\[sldb-end-of-backtrace] - end of backtrace Miscellaneous commands: \\[sldb-restart-frame] - restart frame \\[sldb-return-from-frame] - return from frame \\[sldb-step] - step - \\[sldb-break-with-default-debugger] - switch to default debugger + \\[sldb-break-with-default-debugger] - switch to native debugger + \\[sldb-break-with-system-debugger] - switch to system debugger (gdb) \\[slime-interactive-eval] - eval + \\[sldb-inspect-condition] - inspect signalled condition Full list of commands: @@ -5700,7 +5706,10 @@ (defun sldb-goto-last-frame () (goto-char (point-max)) (while (not (get-text-property (point) 'frame)) - (goto-char (previous-single-property-change (point) 'frame)))) + (goto-char (previous-single-property-change (point) 'frame)) + ;; Recenter to bottom of the window; -2 to account for the + ;; empty last line displayed in sldb buffers. + (recenter -2))) (defun sldb-beginning-of-backtrace () "Goto the first frame." From sboukarev at common-lisp.net Sat Apr 17 18:10:20 2010 From: sboukarev at common-lisp.net (CVS User sboukarev) Date: Sat, 17 Apr 2010 14:10:20 -0400 Subject: [slime-cvs] CVS slime Message-ID: Update of /project/slime/cvsroot/slime In directory cl-net:/tmp/cvs-serv18426 Modified Files: ChangeLog slime.el swank.lisp Log Message: * slime.el (slime-threads-update-interval): New customization variable, if set to a number the threads buffer will updated with this interval. (slime-with-popup-buffer): Rename modes option to mode, for a major mode. Enabling minor modes from within the body doesn't cause troubles. End that way it is compatible with XEmacs since it doesn't need to use minor-mode-list to distinguish between minor and major modes. * swank.lisp (list-threads): Delete the current thread from the listing. --- /project/slime/cvsroot/slime/ChangeLog 2010/04/15 18:01:13 1.2066 +++ /project/slime/cvsroot/slime/ChangeLog 2010/04/17 18:10:20 1.2067 @@ -1,3 +1,16 @@ +2010-04-17 Stas Boukarev + + * slime.el (slime-threads-update-interval): New customization + variable, if set to a number the threads buffer will + updated with this interval. + (slime-with-popup-buffer): Rename modes option to mode, + for a major mode. Enabling minor modes from within the body + doesn't cause troubles. End that way it is compatible with XEmacs + since it doesn't need to use minor-mode-list to distinguish + between minor and major modes. + + * swank.lisp (list-threads): Delete the current thread from the listing. + 2010-04-15 Tobias C. Rittweiler * slime.el (sldb-mode): Include some more commands in its help. --- /project/slime/cvsroot/slime/slime.el 2010/04/15 18:01:13 1.1301 +++ /project/slime/cvsroot/slime/slime.el 2010/04/17 18:10:20 1.1302 @@ -873,7 +873,7 @@ (defvar slime-buffer-connection) ;; Interface -(defmacro* slime-with-popup-buffer ((name &key package connection select modes) +(defmacro* slime-with-popup-buffer ((name &key package connection select mode) &body body) "Similar to `with-output-to-temp-buffer'. Bind standard-output and initialize some buffer-local variables. @@ -882,13 +882,13 @@ NAME is the name of the buffer to be created. PACKAGE is the value `slime-buffer-package'. CONNECTION is the value for `slime-buffer-connection'. -MODES is the list of mode commands. +MODE is the name of a major mode which will be enabled. If nil, no explicit connection is associated with the buffer. If t, the current connection is taken. " `(let* ((vars% (list ,(if (eq package t) '(slime-current-package) package) ,(if (eq connection t) '(slime-connection) connection))) - (standard-output (slime-make-popup-buffer ,name vars% ,modes))) + (standard-output (slime-make-popup-buffer ,name vars% ,mode))) (with-current-buffer standard-output (prog1 (progn , at body) (assert (eq (current-buffer) standard-output)) @@ -898,22 +898,20 @@ (put 'slime-with-popup-buffer 'lisp-indent-function 1) -(defun slime-make-popup-buffer (name buffer-vars modes) +(defun slime-make-popup-buffer (name buffer-vars mode) "Return a temporary buffer called NAME. The buffer also uses the minor-mode `slime-popup-buffer-mode'." (with-current-buffer (get-buffer-create name) (kill-all-local-variables) + (when mode + (funcall mode)) (setq buffer-read-only nil) (erase-buffer) (set-syntax-table lisp-mode-syntax-table) - (slime-init-popup-buffer buffer-vars modes) + (slime-init-popup-buffer buffer-vars) (current-buffer))) -(defun slime-init-popup-buffer (buffer-vars modes) - (dolist (mode modes) - (if (memq mode minor-mode-list) - (funcall mode 1) - (funcall mode))) +(defun slime-init-popup-buffer (buffer-vars) (slime-popup-buffer-mode 1) (multiple-value-setq (slime-buffer-package slime-buffer-connection) buffer-vars)) @@ -2799,7 +2797,7 @@ "Create and display the compilation log buffer." (interactive (list (slime-compiler-notes))) (slime-with-popup-buffer ("*SLIME Compilation*" - :modes '(compilation-mode)) + :mode 'compilation-mode) (slime-insert-compilation-log notes))) (defun slime-insert-compilation-log (notes) @@ -4197,9 +4195,10 @@ (buffer (slime-with-popup-buffer (name :package package :connection t :select t - :modes '(lisp-mode slime-mode - slime-edit-value-mode)) + :mode 'lisp-mode) (slime-popup-buffer-mode -1) ; don't want binding of 'q' + (slime-mode 1) + (slime-edit-value-mode 1) (setq slime-edit-form-string form-string) (insert current-value) (current-buffer)))) @@ -4625,7 +4624,7 @@ (message "No apropos matches for %S" string) (slime-with-popup-buffer ("*SLIME Apropos*" :package package :connection t - :modes '(apropos-mode)) + :mode 'apropos-mode) (if (boundp 'header-line-format) (setq header-line-format summary) (insert summary "\n\n")) @@ -4742,7 +4741,7 @@ :package ,package :connection t :select t - :modes '(slime-xref-mode)) + :mode 'slime-xref-mode) (slime-set-truncate-lines) , at body))) @@ -5137,9 +5136,9 @@ (defun slime-create-macroexpansion-buffer () (let ((name "*SLIME Macroexpansion*")) (slime-with-popup-buffer (name :package t :connection t - :modes '(lisp-mode - slime-mode - slime-macroexpansion-minor-mode)) + :mode 'lisp-mode) + (slime-mode 1) + (slime-macroexpansion-minor-mode 1) (setq font-lock-keywords-case-fold-search t) (current-buffer)))) @@ -6205,14 +6204,27 @@ ;;;; Thread control panel (defvar slime-threads-buffer-name "*SLIME Threads*") +(defvar slime-threads-buffer-timer nil) + +(defcustom slime-threads-update-interval nil + "Interval at which the list of threads will be updated.") (defun slime-list-threads () "Display a list of threads." (interactive) (let ((name slime-threads-buffer-name)) (slime-with-popup-buffer (name :connection t - :modes '(slime-thread-control-mode)) + :mode 'slime-thread-control-mode) (slime-update-threads-buffer) + (goto-char (point-min)) + (when slime-threads-update-interval + (when slime-threads-buffer-timer + (cancel-timer slime-threads-buffer-timer)) + (setq slime-threads-buffer-timer + (run-with-timer + slime-threads-update-interval + slime-threads-update-interval + 'slime-update-threads-buffer))) (setq slime-popup-buffer-quit-function 'slime-quit-threads-buffer)))) (defun slime-longest-lines (list-of-lines) @@ -6227,17 +6239,20 @@ lengths))) (defun slime-quit-threads-buffer (&optional _) - (slime-eval-async `(swank:quit-thread-browser)) - (slime-popup-buffer-quit t)) + (when slime-threads-buffer-timer + (cancel-timer slime-threads-buffer-timer) + (setq slime-threads-buffer-timer nil)) + (slime-popup-buffer-quit t) + (slime-eval-async `(swank:quit-thread-browser))) (defun slime-update-threads-buffer () (interactive) - (let ((threads (slime-eval '(swank:list-threads)))) - (with-current-buffer slime-threads-buffer-name - (let ((inhibit-read-only t)) + (with-current-buffer slime-threads-buffer-name + (let ((threads (slime-eval '(swank:list-threads))) + (inhibit-read-only t)) + (save-excursion (erase-buffer) - (slime-insert-threads threads) - (goto-char (point-min)))))) + (slime-insert-threads threads))))) (defvar *slime-threads-table-properties* '(nil (face bold))) @@ -6301,7 +6316,7 @@ (interactive) (slime-eval `(cl:mapc 'swank:kill-nth-thread ',(slime-get-properties 'thread-id))) - (call-interactively 'slime-list-threads)) + (call-interactively 'slime-update-threads-buffer)) (defun slime-get-region-properties (prop start end) (loop for position = (if (get-text-property start prop) @@ -6383,7 +6398,7 @@ "Display a list of all connections." (interactive) (slime-with-popup-buffer (slime-connections-buffer-name - :modes '(slime-connection-list-mode)) + :mode 'slime-connection-list-mode) (slime-draw-connection-list))) (defun slime-update-connection-list () --- /project/slime/cvsroot/slime/swank.lisp 2010/04/14 17:51:56 1.710 +++ /project/slime/cvsroot/slime/swank.lisp 2010/04/17 18:10:20 1.711 @@ -3708,6 +3708,8 @@ LABELS is a list of attribute names and the remaining lists are the corresponding attribute values per thread." (setq *thread-list* (all-threads)) + (when (use-threads-p) + (setf *thread-list* (delete (current-thread) *thread-list*))) (let* ((plist (thread-attributes (car *thread-list*))) (labels (loop for (key) on plist by #'cddr collect key))) From sboukarev at common-lisp.net Sat Apr 17 18:10:20 2010 From: sboukarev at common-lisp.net (CVS User sboukarev) Date: Sat, 17 Apr 2010 14:10:20 -0400 Subject: [slime-cvs] CVS slime/contrib Message-ID: Update of /project/slime/cvsroot/slime/contrib In directory cl-net:/tmp/cvs-serv18426/contrib Modified Files: slime-clipboard.el slime-compiler-notes-tree.el slime-sprof.el Log Message: * slime.el (slime-threads-update-interval): New customization variable, if set to a number the threads buffer will updated with this interval. (slime-with-popup-buffer): Rename modes option to mode, for a major mode. Enabling minor modes from within the body doesn't cause troubles. End that way it is compatible with XEmacs since it doesn't need to use minor-mode-list to distinguish between minor and major modes. * swank.lisp (list-threads): Delete the current thread from the listing. --- /project/slime/cvsroot/slime/contrib/slime-clipboard.el 2010/04/05 10:53:02 1.4 +++ /project/slime/cvsroot/slime/contrib/slime-clipboard.el 2010/04/17 18:10:20 1.5 @@ -65,7 +65,7 @@ (defun slime-clipboard-display-entries (entries) (slime-with-popup-buffer ("*Slime Clipboard*" - :modes '(slime-clipboard-mode)) + :mode 'slime-clipboard-mode) (slime-clipboard-insert-entries entries))) (defun slime-clipboard-insert-entries (entries) --- /project/slime/cvsroot/slime/contrib/slime-compiler-notes-tree.el 2010/04/05 10:53:02 1.3 +++ /project/slime/cvsroot/slime/contrib/slime-compiler-notes-tree.el 2010/04/17 18:10:20 1.4 @@ -23,7 +23,7 @@ (interactive (list (slime-compiler-notes))) (with-temp-message "Preparing compiler note tree..." (slime-with-popup-buffer ("*SLIME Compiler-Notes*" - :modes '(slime-compiler-notes-mode)) + :mode 'slime-compiler-notes-mode) (when (null notes) (insert "[no notes]")) (let ((collapsed-p)) --- /project/slime/cvsroot/slime/contrib/slime-sprof.el 2010/04/06 02:40:09 1.7 +++ /project/slime/cvsroot/slime/contrib/slime-sprof.el 2010/04/17 18:10:20 1.8 @@ -66,7 +66,8 @@ (interactive) (slime-with-popup-buffer ("*slime-sprof-browser*" :connection t - :modes '(slime-sprof-browser-mode)) + :select t + :mode 'slime-sprof-browser-mode) (slime-sprof-update))) (defun slime-sprof-toggle-swank-exclusion () From sboukarev at common-lisp.net Sun Apr 18 01:35:10 2010 From: sboukarev at common-lisp.net (CVS User sboukarev) Date: Sat, 17 Apr 2010 21:35:10 -0400 Subject: [slime-cvs] CVS slime/contrib Message-ID: Update of /project/slime/cvsroot/slime/contrib In directory cl-net:/tmp/cvs-serv28087 Modified Files: ChangeLog slime-presentations.el swank-presentations.lisp Log Message: * slime-presentations.el (slime-repl-grab-old-output,slime-copy-or-inspect-presentation-at-mouse): If the presentation at point is no longer available, remove presentation properties from the object. * swank-presentations.lisp (lookup-presented-object): defun->defslimefun. --- /project/slime/cvsroot/slime/contrib/ChangeLog 2010/04/06 13:24:29 1.370 +++ /project/slime/cvsroot/slime/contrib/ChangeLog 2010/04/18 01:35:10 1.371 @@ -1,3 +1,11 @@ +2010-04-18 Stas Boukarev + + * slime-presentations.el + (slime-repl-grab-old-output,slime-copy-or-inspect-presentation-at-mouse): + If the presentation at point is no longer available, remove + presentation properties from the object. + * swank-presentations.lisp (lookup-presented-object): defun->defslimefun. + 2010-04-06 Stas Boukarev * slime-c-p-c.el (slime-complete-symbol*-fancy-bit): There is no --- /project/slime/cvsroot/slime/contrib/slime-presentations.el 2010/03/20 08:27:50 1.30 +++ /project/slime/cvsroot/slime/contrib/slime-presentations.el 2010/04/18 01:35:10 1.31 @@ -348,15 +348,22 @@ (unless presentation (error "No presentation at click")) (values presentation start end (current-buffer)))))) - + +(defun slime-check-presentation (from to buffer presentation) + (unless (slime-eval `(cl:nth-value 1 (swank:lookup-presented-object + ',(slime-presentation-id presentation)))) + (with-current-buffer buffer + (slime-remove-presentation-properties from to presentation)))) + (defun slime-copy-or-inspect-presentation-at-mouse (event) (interactive "e") ; no "@" -- we don't want to select the clicked-at window (multiple-value-bind (presentation start end buffer) (slime-presentation-around-click event) + (slime-check-presentation start end buffer presentation) (if (with-current-buffer buffer (eq major-mode 'slime-repl-mode)) (slime-copy-presentation-at-mouse-to-repl event) - (slime-inspect-presentation-at-mouse event)))) + (slime-inspect-presentation-at-mouse event)))) (defun slime-inspect-presentation (presentation start end buffer) (let ((reset-p @@ -382,7 +389,7 @@ (let* ((id (slime-presentation-id presentation)) (presentation-string (format "Presentation %s" id)) (location (slime-eval `(swank:find-definition-for-thing - (swank::lookup-presented-object + (swank:lookup-presented-object ',(slime-presentation-id presentation)))))) (slime-edit-definition-cont (and location (list (make-slime-xref :dspec `(,presentation-string) @@ -670,6 +677,7 @@ output; otherwise the new input is appended." (multiple-value-bind (presentation beg end) (slime-presentation-around-or-before-point (point)) + (slime-check-presentation beg end (current-buffer) presentation) (let ((old-output (buffer-substring beg end))) ;;keep properties ;; Append the old input or replace the current input (cond (replace (goto-char slime-repl-input-start-mark)) @@ -789,12 +797,11 @@ (point-max))) (defun slime-presentation-on-return-pressed () - (cond ((and (car (slime-presentation-around-or-before-point (point))) - (< (point) slime-repl-input-start-mark)) - (slime-repl-grab-old-output end-of-input) - (slime-repl-recenter-if-needed) - t) - (t nil))) + (when (and (car (slime-presentation-around-or-before-point (point))) + (< (point) slime-repl-input-start-mark)) + (slime-repl-grab-old-output end-of-input) + (slime-repl-recenter-if-needed) + t)) (defun slime-presentation-on-stream-open (stream) (require 'bridge) --- /project/slime/cvsroot/slime/contrib/swank-presentations.lisp 2010/03/09 14:42:22 1.6 +++ /project/slime/cvsroot/slime/contrib/swank-presentations.lisp 2010/04/18 01:35:10 1.7 @@ -46,11 +46,11 @@ (setf (gethash object *object-to-presentation-id*) id) id)))) -(defun lookup-presented-object (id) +(defslimefun lookup-presented-object (id) "Retrieve the object corresponding to ID. The secondary value indicates the absence of an entry." (etypecase id - (integer + (integer ;; (multiple-value-bind (object foundp) (gethash id *presentation-id-to-object*) From sboukarev at common-lisp.net Sun Apr 18 17:15:16 2010 From: sboukarev at common-lisp.net (CVS User sboukarev) Date: Sun, 18 Apr 2010 13:15:16 -0400 Subject: [slime-cvs] CVS slime Message-ID: Update of /project/slime/cvsroot/slime In directory cl-net:/tmp/cvs-serv1875 Modified Files: ChangeLog slime.el Log Message: * slime.el (slime-threads-update-interval): Add :group and :type parameters to this customization. Thanks to Mark Harig. --- /project/slime/cvsroot/slime/ChangeLog 2010/04/17 18:10:20 1.2067 +++ /project/slime/cvsroot/slime/ChangeLog 2010/04/18 17:15:16 1.2068 @@ -1,3 +1,9 @@ +2010-04-18 Stas Boukarev + + * slime.el (slime-threads-update-interval): Add :group and :type + parameters to this customization. + Thanks to Mark Harig. + 2010-04-17 Stas Boukarev * slime.el (slime-threads-update-interval): New customization --- /project/slime/cvsroot/slime/slime.el 2010/04/17 18:10:20 1.1302 +++ /project/slime/cvsroot/slime/slime.el 2010/04/18 17:15:16 1.1303 @@ -2580,7 +2580,7 @@ (run-hook-with-args 'slime-before-compile-functions (point-min) (point-max)) (let ((file (slime-to-lisp-filename (buffer-file-name))) (options (slime-simplify-plist `(, at slime-compile-file-options - :policy ,policy)))) + :policy ',policy)))) (slime-eval-async `(swank:compile-file-for-emacs ,file ,(if load t nil) . ,options) #'slime-compilation-finished) @@ -6207,7 +6207,11 @@ (defvar slime-threads-buffer-timer nil) (defcustom slime-threads-update-interval nil - "Interval at which the list of threads will be updated.") + "Interval at which the list of threads will be updated." + :type '(choice + (number :value 0.5) + (const nil)) + :group 'slime-ui) (defun slime-list-threads () "Display a list of threads." From sboukarev at common-lisp.net Mon Apr 19 00:42:29 2010 From: sboukarev at common-lisp.net (CVS User sboukarev) Date: Sun, 18 Apr 2010 20:42:29 -0400 Subject: [slime-cvs] CVS slime Message-ID: Update of /project/slime/cvsroot/slime In directory cl-net:/tmp/cvs-serv4205 Modified Files: ChangeLog swank.lisp Log Message: * swank.lisp (symbol-classification-string): New function to replace (symbol-classification->string (classify-symbol symbol)). It's faster and conses much less, while it is called many times by fuzzy completion and fancy inspector. (symbol-classification->string): Removed. (list-threads): Exclude the current thread only if its name is "worker". --- /project/slime/cvsroot/slime/ChangeLog 2010/04/18 17:15:16 1.2068 +++ /project/slime/cvsroot/slime/ChangeLog 2010/04/19 00:42:28 1.2069 @@ -1,3 +1,13 @@ +2010-04-19 Stas Boukarev + + * swank.lisp (symbol-classification-string): New function to + replace (symbol-classification->string (classify-symbol + symbol)). It's faster and conses much less, while it is called + many times by fuzzy completion and fancy inspector. + (symbol-classification->string): Removed. + (list-threads): Exclude the current thread only if its name is + "worker". + 2010-04-18 Stas Boukarev * slime.el (slime-threads-update-interval): Add :group and :type --- /project/slime/cvsroot/slime/swank.lisp 2010/04/17 18:10:20 1.711 +++ /project/slime/cvsroot/slime/swank.lisp 2010/04/19 00:42:28 1.712 @@ -749,17 +749,29 @@ result))) -(defun symbol-classification->string (flags) - (format nil "~A~A~A~A~A~A~A~A" - (if (or (member :boundp flags) - (member :constant flags)) "b" "-") - (if (member :fboundp flags) "f" "-") - (if (member :generic-function flags) "g" "-") - (if (member :class flags) "c" "-") - (if (member :typespec flags) "t" "-") - (if (member :macro flags) "m" "-") - (if (member :special-operator flags) "s" "-") - (if (member :package flags) "p" "-"))) +(defun symbol-classification-string (symbol) + "Return a string in the form -f-c---- where each letter stands for +boundp fboundp generic-function class macro special-operator package" + (let ((letters "bfgctmsp") + (result (copy-seq "--------"))) + (flet ((type-specifier-p (s) + (or (documentation s 'type) + (not (eq (type-specifier-arglist s) :not-available)))) + (flip (letter) + (setf (char result (position letter letters)) + letter))) + (when (boundp symbol) (flip #\b)) + (when (fboundp symbol) + (flip #\f) + (when (typep (ignore-errors (fdefinition symbol)) + 'generic-function) + (flip #\g))) + (when (type-specifier-p symbol) (flip #\t)) + (when (find-class symbol nil) (flip #\c) ) + (when (macro-function symbol) (flip #\m)) + (when (special-operator-p symbol) (flip #\s)) + (when (find-package symbol) (flip #\p)) + result))) ;;;; TCP Server @@ -3708,7 +3720,8 @@ LABELS is a list of attribute names and the remaining lists are the corresponding attribute values per thread." (setq *thread-list* (all-threads)) - (when (use-threads-p) + (when (and (use-threads-p) + (equalp (thread-name (current-thread)) "worker")) (setf *thread-list* (delete (current-thread) *thread-list*))) (let* ((plist (thread-attributes (car *thread-list*))) (labels (loop for (key) on plist by #'cddr From sboukarev at common-lisp.net Mon Apr 19 00:42:29 2010 From: sboukarev at common-lisp.net (CVS User sboukarev) Date: Sun, 18 Apr 2010 20:42:29 -0400 Subject: [slime-cvs] CVS slime/contrib Message-ID: Update of /project/slime/cvsroot/slime/contrib In directory cl-net:/tmp/cvs-serv4205/contrib Modified Files: swank-fancy-inspector.lisp swank-fuzzy.lisp Log Message: * swank.lisp (symbol-classification-string): New function to replace (symbol-classification->string (classify-symbol symbol)). It's faster and conses much less, while it is called many times by fuzzy completion and fancy inspector. (symbol-classification->string): Removed. (list-threads): Exclude the current thread only if its name is "worker". --- /project/slime/cvsroot/slime/contrib/swank-fancy-inspector.lisp 2010/03/08 16:35:06 1.25 +++ /project/slime/cvsroot/slime/contrib/swank-fancy-inspector.lisp 2010/04/19 00:42:29 1.26 @@ -527,29 +527,25 @@ "Returns an object renderable by Emacs' inspector side that alphabetically lists all the symbols in SYMBOLS together with a concise string representation of what each symbol -represents (cf. CLASSIFY-SYMBOL & Fuzzy Completion.)" +represents (see SYMBOL-CLASSIFICATION-STRING)" (let ((max-length (loop for s in symbols maximizing (length (symbol-name s)))) (distance 10)) ; empty distance between name and classification (flet ((string-representations (symbol) (let* ((name (symbol-name symbol)) (length (length name)) - (padding (- max-length length)) - (classification (classify-symbol symbol))) + (padding (- max-length length))) (values (concatenate 'string name (make-string (+ padding distance) :initial-element #\Space)) - (symbol-classification->string classification))))) + (symbol-classification-string symbol))))) `("" ; 8 is (length "Symbols:") "Symbols:" ,(make-string (+ -8 max-length distance) :initial-element #\Space) "Flags:" (:newline) ,(concatenate 'string ; underlining dashes (make-string (+ max-length distance -1) :initial-element #\-) " " - (let* ((dummy (classify-symbol :foo)) - (dummy (symbol-classification->string dummy)) - (classification-length (length dummy))) - (make-string classification-length :initial-element #\-))) + (symbol-classification-string '#:foo)) (:newline) ,@(loop for symbol in symbols appending (multiple-value-bind (symbol-string classification-string) --- /project/slime/cvsroot/slime/contrib/swank-fuzzy.lisp 2009/07/22 11:25:28 1.9 +++ /project/slime/cvsroot/slime/contrib/swank-fuzzy.lisp 2010/04/19 00:42:29 1.10 @@ -37,7 +37,7 @@ (OFFSET SUBSTRING) and FLAGS is short string describing properties of the symbol (see -CLASSIFY-SYMBOL and STRING-CLASSIFICATION->STRING). +SYMBOL-CLASSIFICATION-STRING). E.g., completing \"mvb\" in a package that uses COMMON-LISP would return something like: @@ -148,7 +148,7 @@ (let ((offset (first chunk)) (string (second chunk))) (list (+ added-length offset) string))) symbol-chunks)) - (symbol-classification->string (classify-symbol symbol)))))) + (symbol-classification-string symbol))))) (defun fuzzy-completion-set (string default-package-name &key limit time-limit-in-msec) "Returns two values: an array of completion objects, sorted by From sboukarev at common-lisp.net Tue Apr 20 02:25:23 2010 From: sboukarev at common-lisp.net (CVS User sboukarev) Date: Mon, 19 Apr 2010 22:25:23 -0400 Subject: [slime-cvs] CVS slime Message-ID: Update of /project/slime/cvsroot/slime In directory cl-net:/tmp/cvs-serv20293 Modified Files: ChangeLog README Log Message: * README: advertise additional contribs, especially slime-fancy. --- /project/slime/cvsroot/slime/ChangeLog 2010/04/19 00:42:28 1.2069 +++ /project/slime/cvsroot/slime/ChangeLog 2010/04/20 02:25:23 1.2070 @@ -1,3 +1,7 @@ +2010-04-20 Stas Boukarev + + * README: advertise additional contribs, especially slime-fancy. + 2010-04-19 Stas Boukarev * swank.lisp (symbol-classification-string): New function to --- /project/slime/cvsroot/slime/README 2006/10/03 21:49:13 1.14 +++ /project/slime/cvsroot/slime/README 2010/04/20 02:25:23 1.15 @@ -20,6 +20,10 @@ Make sure your `inferior-lisp-program' is set to a compatible version of Lisp. + slime-setup command is used also to load additional contribs, most often used + meta-contrib is slime-fancy, it include a better REPL, and many more nice features, + to load it change (slime-setup) form above to (slime-setup '(slime-fancy)) + Use `M-x' slime to fire up and connect to an inferior Lisp. SLIME will now automatically be available in your Lisp source buffers. From sboukarev at common-lisp.net Tue Apr 20 09:31:10 2010 From: sboukarev at common-lisp.net (CVS User sboukarev) Date: Tue, 20 Apr 2010 05:31:10 -0400 Subject: [slime-cvs] CVS slime Message-ID: Update of /project/slime/cvsroot/slime In directory cl-net:/tmp/cvs-serv23546 Modified Files: ChangeLog slime.el Log Message: * slime.el (slime-update-threads-buffer): Save point position on updates. --- /project/slime/cvsroot/slime/ChangeLog 2010/04/20 02:25:23 1.2070 +++ /project/slime/cvsroot/slime/ChangeLog 2010/04/20 09:31:10 1.2071 @@ -1,5 +1,10 @@ 2010-04-20 Stas Boukarev + * slime.el (slime-update-threads-buffer): Save point position + on updates. + +2010-04-20 Stas Boukarev + * README: advertise additional contribs, especially slime-fancy. 2010-04-19 Stas Boukarev --- /project/slime/cvsroot/slime/slime.el 2010/04/18 17:15:16 1.1303 +++ /project/slime/cvsroot/slime/slime.el 2010/04/20 09:31:10 1.1304 @@ -6247,16 +6247,30 @@ (cancel-timer slime-threads-buffer-timer) (setq slime-threads-buffer-timer nil)) (slime-popup-buffer-quit t) + (setq slime-thread-index-to-id nil) (slime-eval-async `(swank:quit-thread-browser))) +(defvar slime-thread-index-to-id nil) + +;;; FIXME: the region selection is jumping (defun slime-update-threads-buffer () (interactive) (with-current-buffer slime-threads-buffer-name - (let ((threads (slime-eval '(swank:list-threads))) - (inhibit-read-only t)) - (save-excursion - (erase-buffer) - (slime-insert-threads threads))))) + (let* ((inhibit-read-only t) + (threads (slime-eval '(swank:list-threads))) + (index (get-text-property (point) 'thread-id)) + (old-thread-id (and (numberp index) + (elt slime-thread-index-to-id index))) + (old-line (line-number-at-pos)) + (old-column (current-column))) + (setq slime-thread-index-to-id (mapcar 'car (cdr threads))) + (erase-buffer) + (slime-insert-threads threads) + (let ((new-position (position old-thread-id threads :key 'car))) + (goto-char (point-min)) + (forward-line (1- (or new-position old-line))) + (move-to-column old-column) + (set-window-point (get-buffer-window (current-buffer)) (point)))))) (defvar *slime-threads-table-properties* '(nil (face bold))) @@ -6292,10 +6306,10 @@ (concat (propertize " " 'display '((space :align-to 0))) labels)) (insert labels)) - (loop for thread-id from 0 + (loop for index from 0 for thread in (cdr threads) do - (slime-propertize-region `(thread-id ,thread-id) + (slime-propertize-region `(thread-id ,index) (slime-insert-thread thread longest-lines))))) @@ -6308,7 +6322,8 @@ \\{slime-thread-control-mode-map} \\{slime-popup-buffer-mode-map}" (when slime-truncate-lines - (set (make-local-variable 'truncate-lines) t))) + (set (make-local-variable 'truncate-lines) t)) + (setq buffer-undo-list t)) (slime-define-keys slime-thread-control-mode-map ("a" 'slime-thread-attach) From trittweiler at common-lisp.net Tue Apr 20 09:48:19 2010 From: trittweiler at common-lisp.net (CVS User trittweiler) Date: Tue, 20 Apr 2010 05:48:19 -0400 Subject: [slime-cvs] CVS slime Message-ID: Update of /project/slime/cvsroot/slime In directory cl-net:/tmp/cvs-serv7771 Modified Files: ChangeLog swank-sbcl.lisp Log Message: * swank-sbcl.lisp (condition-timed-wait): New helper. Use WITH-DEADLINE rather than WITH-TIMEOUT because the latter conses a new timer, and this function is called _a lot_. (receive-if): Use it. --- /project/slime/cvsroot/slime/ChangeLog 2010/04/20 09:31:10 1.2071 +++ /project/slime/cvsroot/slime/ChangeLog 2010/04/20 09:48:19 1.2072 @@ -1,3 +1,10 @@ +2010-04-20 Tobias C. Rittweiler + + * swank-sbcl.lisp (condition-timed-wait): New helper. Use + WITH-DEADLINE rather than WITH-TIMEOUT because the latter conses a + new timer, and this function is called _a lot_. + (receive-if): Use it. + 2010-04-20 Stas Boukarev * slime.el (slime-update-threads-buffer): Save point position --- /project/slime/cvsroot/slime/swank-sbcl.lisp 2010/03/02 14:36:48 1.269 +++ /project/slime/cvsroot/slime/swank-sbcl.lisp 2010/04/20 09:48:19 1.270 @@ -1450,10 +1450,25 @@ (setf (mailbox.queue mbox) (nconc (mailbox.queue mbox) (list message))) (sb-thread:condition-broadcast (mailbox.waitqueue mbox))))) - + #-sb-lutex + (defun condition-timed-wait (waitqueue mutex timeout) + (handler-case + (let ((*break-on-signals* nil)) + (sb-sys:with-deadline (:seconds timeout :override t) + (sb-thread:condition-wait waitqueue mutex) t)) + (sb-ext:timeout () + nil))) + + ;; FIXME: with-timeout doesn't work properly on Darwin + #+sb-lutex + (defun condition-timed-wait (waitqueue mutex timeout) + (declare (ignore timeout)) + (sb-thread:condition-wait waitqueue mutex)) + (defimplementation receive-if (test &optional timeout) (let* ((mbox (mailbox (current-thread))) - (mutex (mailbox.mutex mbox))) + (mutex (mailbox.mutex mbox)) + (waitq (mailbox.waitqueue mbox))) (assert (or (not timeout) (eq timeout t))) (loop (check-slime-interrupts) @@ -1464,17 +1479,7 @@ (setf (mailbox.queue mbox) (nconc (ldiff q tail) (cdr tail))) (return (car tail)))) (when (eq timeout t) (return (values nil t))) - ;; FIXME: with-timeout doesn't work properly on Darwin - #+linux - (handler-case - (let ((*break-on-signals* nil)) - (sb-ext:with-timeout 0.2 - (sb-thread:condition-wait (mailbox.waitqueue mbox) - mutex))) - (sb-ext:timeout ())) - #-linux - (sb-thread:condition-wait (mailbox.waitqueue mbox) - mutex))))) + (condition-timed-wait waitq mutex 0.2))))) ) (defimplementation quit-lisp () From sboukarev at common-lisp.net Wed Apr 21 08:54:12 2010 From: sboukarev at common-lisp.net (CVS User sboukarev) Date: Wed, 21 Apr 2010 04:54:12 -0400 Subject: [slime-cvs] CVS slime Message-ID: Update of /project/slime/cvsroot/slime In directory cl-net:/tmp/cvs-serv2491 Modified Files: ChangeLog slime.el Log Message: * slime.el (slime-open-inspector): Use forward-line instead of goto-line, since it doesn't result in "Mark set" message. (slime-inspector-buffer): Enable slime-mode after enabling slime-inspector-mode, otherwise the former will be disabled by the latter. --- /project/slime/cvsroot/slime/ChangeLog 2010/04/20 09:48:19 1.2072 +++ /project/slime/cvsroot/slime/ChangeLog 2010/04/21 08:54:10 1.2073 @@ -1,3 +1,11 @@ +2010-04-21 Stas Boukarev + + * slime.el (slime-open-inspector): Use forward-line instead of + goto-line, since it doesn't result in "Mark set" message. + (slime-inspector-buffer): Enable slime-mode after enabling + slime-inspector-mode, otherwise the former will be disabled by the + latter. + 2010-04-20 Tobias C. Rittweiler * swank-sbcl.lisp (condition-timed-wait): New helper. Use --- /project/slime/cvsroot/slime/slime.el 2010/04/20 09:31:10 1.1304 +++ /project/slime/cvsroot/slime/slime.el 2010/04/21 08:54:11 1.1305 @@ -6506,9 +6506,9 @@ (or (get-buffer "*Slime Inspector*") (with-current-buffer (get-buffer-create "*Slime Inspector*") (setq slime-inspector-mark-stack '()) - (buffer-disable-undo) - (slime-mode t) (slime-inspector-mode) + (slime-mode t) + (buffer-disable-undo) (make-local-variable 'slime-saved-window-config) (setq slime-saved-window-config (current-window-configuration)) (current-buffer)))) @@ -6544,8 +6544,9 @@ (pop-to-buffer (current-buffer)) (when point (check-type point cons) - (ignore-errors - (goto-line (car point)) + (ignore-errors + (goto-char (point-min)) + (forward-line (1- (car point))) (move-to-column (cdr point))))))))) (defvar slime-inspector-limit 500) From sboukarev at common-lisp.net Thu Apr 22 05:47:35 2010 From: sboukarev at common-lisp.net (CVS User sboukarev) Date: Thu, 22 Apr 2010 01:47:35 -0400 Subject: [slime-cvs] CVS slime Message-ID: Update of /project/slime/cvsroot/slime In directory cl-net:/tmp/cvs-serv16897 Modified Files: ChangeLog swank-backend.lisp swank-sbcl.lisp Log Message: * swank-backend.lisp (with-symbol): Test for package before doing find-symbol. * swank-sbcl.lisp(Multiprocessing): use with-symbol. (emacs-inspect t): Remove newlines from text returned by sb-impl::inspected-parts, otherwise there will be ".." inserted by the printer due to (*print-lines* 1). --- /project/slime/cvsroot/slime/ChangeLog 2010/04/21 08:54:10 1.2073 +++ /project/slime/cvsroot/slime/ChangeLog 2010/04/22 05:47:35 1.2074 @@ -1,3 +1,12 @@ +2010-04-22 Stas Boukarev + + * swank-backend.lisp (with-symbol): Test for package before doing + find-symbol. + * swank-sbcl.lisp(Multiprocessing): use with-symbol. + (emacs-inspect t): Remove newlines from text returned by + sb-impl::inspected-parts, otherwise there will be ".." inserted by + the printer due to (*print-lines* 1). + 2010-04-21 Stas Boukarev * slime.el (slime-open-inspector): Use forward-line instead of --- /project/slime/cvsroot/slime/swank-backend.lisp 2010/03/19 12:32:30 1.198 +++ /project/slime/cvsroot/slime/swank-backend.lisp 2010/04/22 05:47:35 1.199 @@ -260,7 +260,8 @@ (defun with-symbol (name package) "Generate a form suitable for testing with #+." - (if (find-symbol (string name) (string package)) + (if (and (find-package package) + (find-symbol (string name) package)) '(:and) '(:or))) --- /project/slime/cvsroot/slime/swank-sbcl.lisp 2010/04/20 09:48:19 1.270 +++ /project/slime/cvsroot/slime/swank-sbcl.lisp 2010/04/22 05:47:35 1.271 @@ -1269,11 +1269,13 @@ (label-value-line* (:value (sb-kernel:value-cell-ref o)))) (t (multiple-value-bind (text label parts) (sb-impl::inspected-parts o) - (list* (format nil "~a~%" text) + (list* (string-right-trim '(#\Newline) text) + '(:newline) (if label (loop for (l . v) in parts append (label-value-line l v)) - (loop for value in parts for i from 0 + (loop for value in parts + for i from 0 append (label-value-line i value)))))))) (defmethod emacs-inspect ((o function)) @@ -1343,7 +1345,7 @@ ;;;; Multiprocessing #+(and sb-thread - #.(cl:if (cl:find-symbol "THREAD-NAME" "SB-THREAD") '(and) '(or))) + #.(swank-backend:with-symbol "THREAD-NAME" "SB-THREAD")) (progn (defvar *thread-id-counter* 0) From sboukarev at common-lisp.net Fri Apr 23 02:46:28 2010 From: sboukarev at common-lisp.net (CVS User sboukarev) Date: Thu, 22 Apr 2010 22:46:28 -0400 Subject: [slime-cvs] CVS slime Message-ID: Update of /project/slime/cvsroot/slime In directory cl-net:/tmp/cvs-serv6665 Modified Files: ChangeLog README slime.el Log Message: * slime.el (slime-inspector-buffer): Use slime-with-popup-buffer, that solves the problem with keybindings shadowed by slime-mode. Reported by Nathan Bird. * README: Better wording. --- /project/slime/cvsroot/slime/ChangeLog 2010/04/22 05:47:35 1.2074 +++ /project/slime/cvsroot/slime/ChangeLog 2010/04/23 02:46:27 1.2075 @@ -1,3 +1,11 @@ +2010-04-23 Stas Boukarev + + * slime.el (slime-inspector-buffer): Use slime-with-popup-buffer, + that solves the problem with keybindings shadowed by slime-mode. + Reported by Nathan Bird. + + * README: Better wording. + 2010-04-22 Stas Boukarev * swank-backend.lisp (with-symbol): Test for package before doing --- /project/slime/cvsroot/slime/README 2010/04/20 02:25:23 1.15 +++ /project/slime/cvsroot/slime/README 2010/04/23 02:46:28 1.16 @@ -20,10 +20,13 @@ Make sure your `inferior-lisp-program' is set to a compatible version of Lisp. - slime-setup command is used also to load additional contribs, most often used - meta-contrib is slime-fancy, it include a better REPL, and many more nice features, - to load it change (slime-setup) form above to (slime-setup '(slime-fancy)) - + The function `slime-setup' can also load additional, contributed + packages ("contribs"). The most-often used package is + slime-fancy.el, which primarily installs a popular set of other + contributed packages. It includes a better REPL, and many more nice + features. To load it, change the bare (slime-setup) form above to + (slime-setup '(slime-fancy)). + Use `M-x' slime to fire up and connect to an inferior Lisp. SLIME will now automatically be available in your Lisp source buffers. --- /project/slime/cvsroot/slime/slime.el 2010/04/21 08:54:11 1.1305 +++ /project/slime/cvsroot/slime/slime.el 2010/04/23 02:46:28 1.1306 @@ -6497,21 +6497,24 @@ (slime-sexp-at-point)))) (slime-eval-async `(swank:init-inspector ,string) 'slime-open-inspector)) -(define-derived-mode slime-inspector-mode fundamental-mode "Slime-Inspector" +(define-derived-mode slime-inspector-mode fundamental-mode + "Slime-Inspector" + " +\\{slime-inspector-mode-map} +\\{slime-popup-buffer-mode-map}" (set-syntax-table lisp-mode-syntax-table) (slime-set-truncate-lines) (setq buffer-read-only t)) (defun slime-inspector-buffer () (or (get-buffer "*Slime Inspector*") - (with-current-buffer (get-buffer-create "*Slime Inspector*") - (setq slime-inspector-mark-stack '()) - (slime-inspector-mode) - (slime-mode t) + (slime-with-popup-buffer ("*Slime Inspector*" :mode 'slime-inspector-mode) + (setq slime-inspector-mark-stack '()) (buffer-disable-undo) (make-local-variable 'slime-saved-window-config) + (setq slime-popup-buffer-quit-function 'slime-inspector-quit) (setq slime-saved-window-config (current-window-configuration)) - (current-buffer)))) + (current-buffer)))) (defmacro slime-inspector-fontify (face string) `(slime-add-face ',(intern (format "slime-inspector-%s-face" face)) ,string)) @@ -6655,12 +6658,12 @@ (t (message "No next object") (ding))))) -(defun slime-inspector-quit () +(defun slime-inspector-quit (&optional kill-buffer) "Quit the inspector and kill the buffer." (interactive) (slime-eval-async `(swank:quit-inspector)) (set-window-configuration slime-saved-window-config) - (kill-buffer (current-buffer))) + (slime-popup-buffer-quit t)) ;; FIXME: first return value is just point. ;; FIXME: could probably use slime-search-property. @@ -6833,7 +6836,6 @@ ("p" 'slime-inspector-pprint) ("e" 'slime-inspector-eval) ("h" 'slime-inspector-history) - ("q" 'slime-inspector-quit) ("g" 'slime-inspector-reinspect) ("v" 'slime-inspector-toggle-verbose) ("\C-i" 'slime-inspector-next-inspectable-object) From sboukarev at common-lisp.net Fri Apr 23 03:00:20 2010 From: sboukarev at common-lisp.net (CVS User sboukarev) Date: Thu, 22 Apr 2010 23:00:20 -0400 Subject: [slime-cvs] CVS slime Message-ID: Update of /project/slime/cvsroot/slime In directory cl-net:/tmp/cvs-serv13734 Modified Files: ChangeLog slime.el Log Message: * slime.el (slime-update-threads-buffer): Use slime-eval-async. --- /project/slime/cvsroot/slime/ChangeLog 2010/04/23 02:46:27 1.2075 +++ /project/slime/cvsroot/slime/ChangeLog 2010/04/23 03:00:20 1.2076 @@ -1,5 +1,9 @@ 2010-04-23 Stas Boukarev + * slime.el (slime-update-threads-buffer): Use slime-eval-async + +2010-04-23 Stas Boukarev + * slime.el (slime-inspector-buffer): Use slime-with-popup-buffer, that solves the problem with keybindings shadowed by slime-mode. Reported by Nathan Bird. --- /project/slime/cvsroot/slime/slime.el 2010/04/23 02:46:28 1.1306 +++ /project/slime/cvsroot/slime/slime.el 2010/04/23 03:00:20 1.1307 @@ -6250,14 +6250,18 @@ (setq slime-thread-index-to-id nil) (slime-eval-async `(swank:quit-thread-browser))) +(defun slime-update-threads-buffer () + (interactive) + (with-current-buffer slime-threads-buffer-name + (slime-eval-async '(swank:list-threads) + 'slime-display-threads))) + (defvar slime-thread-index-to-id nil) ;;; FIXME: the region selection is jumping -(defun slime-update-threads-buffer () - (interactive) +(defun slime-display-threads (threads) (with-current-buffer slime-threads-buffer-name (let* ((inhibit-read-only t) - (threads (slime-eval '(swank:list-threads))) (index (get-text-property (point) 'thread-id)) (old-thread-id (and (numberp index) (elt slime-thread-index-to-id index))) From sboukarev at common-lisp.net Sat Apr 24 04:44:38 2010 From: sboukarev at common-lisp.net (CVS User sboukarev) Date: Sat, 24 Apr 2010 00:44:38 -0400 Subject: [slime-cvs] CVS slime Message-ID: Update of /project/slime/cvsroot/slime In directory cl-net:/tmp/cvs-serv10543 Modified Files: ChangeLog swank.lisp Log Message: * swank.lisp (format-values-for-echo-area): Also print the length of an integer in bits. --- /project/slime/cvsroot/slime/ChangeLog 2010/04/23 03:00:20 1.2076 +++ /project/slime/cvsroot/slime/ChangeLog 2010/04/24 04:44:38 1.2077 @@ -1,6 +1,11 @@ +2010-04-24 Stas Boukarev + + * swank.lisp (format-values-for-echo-area): Also print the length of an + integer in bits. + 2010-04-23 Stas Boukarev - * slime.el (slime-update-threads-buffer): Use slime-eval-async + * slime.el (slime-update-threads-buffer): Use slime-eval-async. 2010-04-23 Stas Boukarev --- /project/slime/cvsroot/slime/swank.lisp 2010/04/19 00:42:28 1.712 +++ /project/slime/cvsroot/slime/swank.lisp 2010/04/24 04:44:38 1.713 @@ -2182,8 +2182,9 @@ (cond ((null values) "; No value") ((and (integerp (car values)) (null (cdr values))) (let ((i (car values))) - (format nil "~A~D (#x~X, #o~O, #b~B)" - *echo-area-prefix* i i i i))) + (format nil "~A~D (~a bit~:p, #x~X, #o~O, #b~B)" + *echo-area-prefix* + i (integer-length i) i i i))) (t (format nil "~a~{~S~^, ~}" *echo-area-prefix* values)))))) (defmacro values-to-string (values) From sboukarev at common-lisp.net Tue Apr 27 13:03:59 2010 From: sboukarev at common-lisp.net (CVS User sboukarev) Date: Tue, 27 Apr 2010 09:03:59 -0400 Subject: [slime-cvs] CVS slime Message-ID: Update of /project/slime/cvsroot/slime In directory cl-net:/tmp/cvs-serv5709 Modified Files: ChangeLog slime.el Log Message: * slime.el (slime-info): New function, opens the manual. --- /project/slime/cvsroot/slime/ChangeLog 2010/04/24 04:44:38 1.2077 +++ /project/slime/cvsroot/slime/ChangeLog 2010/04/27 13:03:59 1.2078 @@ -1,3 +1,7 @@ +2010-04-27 Stas Boukarev + + * slime.el (slime-info): New function, opens the manual. + 2010-04-24 Stas Boukarev * swank.lisp (format-values-for-echo-area): Also print the length of an --- /project/slime/cvsroot/slime/slime.el 2010/04/23 03:00:20 1.1307 +++ /project/slime/cvsroot/slime/slime.el 2010/04/27 13:03:59 1.1308 @@ -4689,6 +4689,15 @@ (item (get-text-property pos 'item))) (slime-eval-describe `(swank:describe-definition-for-emacs ,item ,type)))) +(defun slime-info () + "Open Slime manual" + (interactive) + (let ((file (expand-file-name "doc/slime.info" slime-path))) + (if (file-exists-p file) + (info file) + (message "No slime.info, run `make slime.info' in %s" + (expand-file-name "doc/" slime-path))))) + ;;;; XREF: cross-referencing From sboukarev at common-lisp.net Fri Apr 30 03:14:36 2010 From: sboukarev at common-lisp.net (CVS User sboukarev) Date: Thu, 29 Apr 2010 23:14:36 -0400 Subject: [slime-cvs] CVS slime Message-ID: Update of /project/slime/cvsroot/slime In directory cl-net:/tmp/cvs-serv3317 Modified Files: ChangeLog slime.el Log Message: * slime.el (slime-compile-file): Run check-parens after checking that the buffer is associated with a file. --- /project/slime/cvsroot/slime/ChangeLog 2010/04/27 13:03:59 1.2078 +++ /project/slime/cvsroot/slime/ChangeLog 2010/04/30 03:14:35 1.2079 @@ -1,3 +1,8 @@ +2010-04-29 Stas Boukarev + + * slime.el (slime-compile-file): Run check-parens after checking + that the buffer is associated with a file. + 2010-04-27 Stas Boukarev * slime.el (slime-info): New function, opens the manual. --- /project/slime/cvsroot/slime/slime.el 2010/04/27 13:03:59 1.1308 +++ /project/slime/cvsroot/slime/slime.el 2010/04/30 03:14:36 1.1309 @@ -2571,9 +2571,9 @@ See `slime-compile-and-load-file' for further details." (interactive) - (check-parens) (unless buffer-file-name (error "Buffer %s is not associated with a file." (buffer-name))) + (check-parens) (when (and (buffer-modified-p) (y-or-n-p (format "Save file %s? " (buffer-file-name)))) (save-buffer))