From lgorrie at common-lisp.net Wed Feb 2 03:08:31 2005 From: lgorrie at common-lisp.net (Luke Gorrie) Date: Wed, 2 Feb 2005 04:08:31 +0100 (CET) Subject: [slime-cvs] CVS update: slime/slime.el Message-ID: <20050202030831.2BFDC88686@common-lisp.net> Update of /project/slime/cvsroot/slime In directory common-lisp.net:/tmp/cvs-serv4120 Modified Files: slime.el Log Message: (slime-repl-send-input): Move some properties of old REPL input (e.g. read-only) from text properties into an overlay, so that kill/yank will leave them behind. Left `slime-repl-old-input' as a text properties because it's more convenient to lookup that way. (slime-repl-return): Ignore `slime-repl-old-input' property if the point is in front of the current REPL prompt, i.e. if the user has copy&pasted some old REPL input into the current input area. Date: Wed Feb 2 04:08:28 2005 Author: lgorrie Index: slime/slime.el diff -u slime/slime.el:1.454 slime/slime.el:1.455 --- slime/slime.el:1.454 Sun Jan 30 10:29:14 2005 +++ slime/slime.el Wed Feb 2 04:08:23 2005 @@ -2740,7 +2740,8 @@ (interactive "P") (slime-check-connected) (assert (<= (point) slime-repl-input-end-mark)) - (cond ((get-text-property (point) 'slime-repl-old-input) + (cond ((and (get-text-property (point) 'slime-repl-old-input) + (< (point) slime-repl-input-start-mark)) (slime-repl-grab-old-input end-of-input)) (end-of-input (slime-repl-send-input)) @@ -2761,12 +2762,14 @@ (goto-char slime-repl-input-end-mark) (when newline (insert "\n")) (add-text-properties slime-repl-input-start-mark (point) - `(face slime-repl-input-face - rear-nonsticky (face slime-repl-old-input) - slime-repl-old-input - ,(incf slime-repl-old-input-counter))) + `(slime-repl-old-input + ,(incf slime-repl-old-input-counter))) (let ((overlay (make-overlay slime-repl-input-start-mark (point)))) - (overlay-put overlay 'read-only t)) + ;; These properties are on an overlay so that they won't be taken + ;; by kill/yank. + (overlay-put overlay 'read-only t) + (overlay-put overlay 'face 'slime-repl-input-face) + (overlay-put overlay 'rear-nonsticky '(face slime-repl-old-input-counter))) (let ((input (slime-repl-current-input))) (goto-char slime-repl-input-end-mark) (slime-mark-input-start) From lgorrie at common-lisp.net Wed Feb 2 03:09:43 2005 From: lgorrie at common-lisp.net (Luke Gorrie) Date: Wed, 2 Feb 2005 04:09:43 +0100 (CET) Subject: [slime-cvs] CVS update: slime/ChangeLog Message-ID: <20050202030943.500AC88669@common-lisp.net> Update of /project/slime/cvsroot/slime In directory common-lisp.net:/tmp/cvs-serv4156 Modified Files: ChangeLog Log Message: Date: Wed Feb 2 04:09:37 2005 Author: lgorrie Index: slime/ChangeLog diff -u slime/ChangeLog:1.607 slime/ChangeLog:1.608 --- slime/ChangeLog:1.607 Sun Jan 30 10:43:52 2005 +++ slime/ChangeLog Wed Feb 2 04:09:36 2005 @@ -1,3 +1,14 @@ +2005-02-02 Luke Gorrie + + * slime.el (slime-repl-send-input): Move some properties + of old REPL input (e.g. read-only) from text properties into an + overlay, so that kill/yank will leave them behind. Left + `slime-repl-old-input' as a text properties because it's more + convenient to lookup that way. + (slime-repl-return): Ignore `slime-repl-old-input' property if the + point is in front of the current REPL prompt, i.e. if the user has + copy&pasted some old REPL input into the current input area. + 2005-01-30 Bryan O'Connor * slime.el (slime-goto-location-position): Changed the regexp to @@ -69,6 +80,7 @@ (arglist-for-insertion): Use it (decode-keyword-arg, decode-optional-arg): New functions. +>>>>>>> 1.607 2005-01-19 Lars Magne Ingebrigtsen * slime.el (slime-header-line-p): Customize variable to From lgorrie at common-lisp.net Wed Feb 2 03:12:34 2005 From: lgorrie at common-lisp.net (Luke Gorrie) Date: Wed, 2 Feb 2005 04:12:34 +0100 (CET) Subject: [slime-cvs] CVS update: slime/ChangeLog Message-ID: <20050202031234.903D38802C@common-lisp.net> Update of /project/slime/cvsroot/slime In directory common-lisp.net:/tmp/cvs-serv4212 Modified Files: ChangeLog Log Message: Date: Wed Feb 2 04:12:33 2005 Author: lgorrie Index: slime/ChangeLog diff -u slime/ChangeLog:1.608 slime/ChangeLog:1.609 --- slime/ChangeLog:1.608 Wed Feb 2 04:09:36 2005 +++ slime/ChangeLog Wed Feb 2 04:12:33 2005 @@ -80,7 +80,6 @@ (arglist-for-insertion): Use it (decode-keyword-arg, decode-optional-arg): New functions. ->>>>>>> 1.607 2005-01-19 Lars Magne Ingebrigtsen * slime.el (slime-header-line-p): Customize variable to From heller at common-lisp.net Wed Feb 2 20:33:26 2005 From: heller at common-lisp.net (Helmut Eller) Date: Wed, 2 Feb 2005 21:33:26 +0100 (CET) Subject: [slime-cvs] CVS update: slime/slime.el Message-ID: <20050202203326.3398E8802C@common-lisp.net> Update of /project/slime/cvsroot/slime In directory common-lisp.net:/tmp/cvs-serv27904 Modified Files: slime.el Log Message: Require the timer package explicitly. Date: Wed Feb 2 21:33:24 2005 Author: heller Index: slime/slime.el diff -u slime/slime.el:1.455 slime/slime.el:1.456 --- slime/slime.el:1.455 Wed Feb 2 04:08:23 2005 +++ slime/slime.el Wed Feb 2 21:33:23 2005 @@ -55,6 +55,7 @@ (require 'easy-mmode) (defalias 'define-minor-mode 'easy-mmode-define-minor-mode))) (require 'comint) +(require 'timer) (require 'pp) (require 'hideshow) (require 'hyperspec) From heller at common-lisp.net Wed Feb 2 20:36:51 2005 From: heller at common-lisp.net (Helmut Eller) Date: Wed, 2 Feb 2005 21:36:51 +0100 (CET) Subject: [slime-cvs] CVS update: slime/ChangeLog Message-ID: <20050202203651.6B8578802C@common-lisp.net> Update of /project/slime/cvsroot/slime In directory common-lisp.net:/tmp/cvs-serv27950 Modified Files: ChangeLog Log Message: *** empty log message *** Date: Wed Feb 2 21:36:49 2005 Author: heller Index: slime/ChangeLog diff -u slime/ChangeLog:1.609 slime/ChangeLog:1.610 --- slime/ChangeLog:1.609 Wed Feb 2 04:12:33 2005 +++ slime/ChangeLog Wed Feb 2 21:36:49 2005 @@ -1,3 +1,7 @@ +2005-02-02 Helmut Eller + + * slime.el: Require the timer package explicitly. + 2005-02-02 Luke Gorrie * slime.el (slime-repl-send-input): Move some properties From asimon at common-lisp.net Thu Feb 10 19:22:47 2005 From: asimon at common-lisp.net (Andras Simon) Date: Thu, 10 Feb 2005 20:22:47 +0100 (CET) Subject: [slime-cvs] CVS update: slime/swank-abcl.lisp Message-ID: <20050210192247.ABBDB88660@common-lisp.net> Update of /project/slime/cvsroot/slime In directory common-lisp.net:/tmp/cvs-serv22974 Modified Files: swank-abcl.lisp Log Message: source-location: conform to abcl's new protocol (Peter Graves) pprint frames Date: Thu Feb 10 20:22:44 2005 Author: asimon Index: slime/swank-abcl.lisp diff -u slime/swank-abcl.lisp:1.23 slime/swank-abcl.lisp:1.24 --- slime/swank-abcl.lisp:1.23 Mon Nov 29 18:35:03 2004 +++ slime/swank-abcl.lisp Thu Feb 10 20:22:43 2005 @@ -201,7 +201,7 @@ (subseq (ext:backtrace-as-list) start end))) (defimplementation print-frame (frame stream) - (print frame stream)) + (pprint frame stream)) #+nil (defimplementation frame-locals (index) @@ -316,13 +316,13 @@ |# (defun source-location (symbol) - (when (ext:source symbol) + (when (pathnamep (ext:source-pathname symbol)) `(((,symbol) (:location (:file ,(namestring (ext:source-pathname symbol))) (:position ,(or (ext:source-file-position symbol) 0) t) (:snippet nil)))))) - + (defimplementation find-definitions (symbol) (source-location symbol)) From mbaringer at common-lisp.net Fri Feb 18 16:01:54 2005 From: mbaringer at common-lisp.net (Marco Baringer) Date: Fri, 18 Feb 2005 17:01:54 +0100 (CET) Subject: [slime-cvs] CVS update: /slime/slime.el Message-ID: <20050218160154.B557C884FA@common-lisp.net> Update of /project/slime/cvsroot//slime In directory common-lisp.net:/tmp/cvs-serv31506 Modified Files: slime.el Log Message: (slime-dispatch-event): Added the :evaluate-in-emacs dispatch state which simply parses the message and class evaluate-in-emacs. (evaluate-in-emacs): New function. (complete-name-context-at-point, name-context-at-point, out-first, definition-name, parameter-specializers, slime-toggle-trace-fdefinition, slime-toggle-trace-function, slime-toggle-trace-defgeneric, slime-toggle-trace-defmethod, slime-toggle-trace-maybe-wherein, slime-toggle-trace-within): New functions implementing the new intelligent slime trace. Date: Fri Feb 18 17:01:54 2005 Author: mbaringer From mbaringer at common-lisp.net Fri Feb 18 16:03:36 2005 From: mbaringer at common-lisp.net (Marco Baringer) Date: Fri, 18 Feb 2005 17:03:36 +0100 (CET) Subject: [slime-cvs] CVS update: /slime/swank-allegro.lisp Message-ID: <20050218160336.554F1884FA@common-lisp.net> Update of /project/slime/cvsroot//slime In directory common-lisp.net:/tmp/cvs-serv31542 Modified Files: swank-allegro.lisp Log Message: (toggle-trace-generic-function-methods, toggle-trace, toggle-trace-function, toggle-trace-method, toggle-trace-fdefinition-wherein, toggle-trace-fdefinition-within): Implement. (process-fspec-for-allegro): New function. Date: Fri Feb 18 17:03:35 2005 Author: mbaringer From mbaringer at common-lisp.net Fri Feb 18 16:03:49 2005 From: mbaringer at common-lisp.net (Marco Baringer) Date: Fri, 18 Feb 2005 17:03:49 +0100 (CET) Subject: [slime-cvs] CVS update: /slime/swank-backend.lisp Message-ID: <20050218160349.09F83884FA@common-lisp.net> Update of /project/slime/cvsroot//slime In directory common-lisp.net:/tmp/cvs-serv31563 Modified Files: swank-backend.lisp Log Message: (toggle-trace-function, toggle-trace-generic-function-methods, toggle-trace-method, toggle-trace-fdefinition-wherein, toggle-trace-fdefinition-within): New backend functions for the new trace facility. Date: Fri Feb 18 17:03:48 2005 Author: mbaringer From mbaringer at common-lisp.net Fri Feb 18 16:04:00 2005 From: mbaringer at common-lisp.net (Marco Baringer) Date: Fri, 18 Feb 2005 17:04:00 +0100 (CET) Subject: [slime-cvs] CVS update: /slime/swank-cmucl.lisp Message-ID: <20050218160400.38D60884FA@common-lisp.net> Update of /project/slime/cvsroot//slime In directory common-lisp.net:/tmp/cvs-serv31580 Modified Files: swank-cmucl.lisp Log Message: (toggle-trace-generic-function-methods, toggle-trace-function, toggle-trace-method, toggle-trace-fdefinition-wherein): Implement. (toggle-trace, process-fspec): New functions. Date: Fri Feb 18 17:03:59 2005 Author: mbaringer From mbaringer at common-lisp.net Fri Feb 18 16:04:14 2005 From: mbaringer at common-lisp.net (Marco Baringer) Date: Fri, 18 Feb 2005 17:04:14 +0100 (CET) Subject: [slime-cvs] CVS update: /slime/swank-sbcl.lisp Message-ID: <20050218160414.8B2D5884FA@common-lisp.net> Update of /project/slime/cvsroot//slime In directory common-lisp.net:/tmp/cvs-serv31596 Modified Files: swank-sbcl.lisp Log Message: (toggle-trace-generic-function-methods, toggle-trace-function, toggle-trace-method, toggle-trace-fdefinition-wherein): Implement. (toggle-trace, process-fspec): New functions. Date: Fri Feb 18 17:04:13 2005 Author: mbaringer From mbaringer at common-lisp.net Fri Feb 18 16:04:30 2005 From: mbaringer at common-lisp.net (Marco Baringer) Date: Fri, 18 Feb 2005 17:04:30 +0100 (CET) Subject: [slime-cvs] CVS update: /slime/swank.lisp Message-ID: <20050218160430.3793A884FA@common-lisp.net> Update of /project/slime/cvsroot//slime In directory common-lisp.net:/tmp/cvs-serv31611 Modified Files: swank.lisp Log Message: (dispatch-event): Handle the :evaluate-in-emacs message type. (evaluate-in-emacs): New function. Date: Fri Feb 18 17:04:29 2005 Author: mbaringer From mbaringer at common-lisp.net Fri Feb 18 16:08:08 2005 From: mbaringer at common-lisp.net (Marco Baringer) Date: Fri, 18 Feb 2005 17:08:08 +0100 (CET) Subject: [slime-cvs] CVS update: /slime/ChangeLog Message-ID: <20050218160808.AB962884FA@common-lisp.net> Update of /project/slime/cvsroot//slime In directory common-lisp.net:/tmp/cvs-serv31635 Modified Files: ChangeLog Log Message: see ChangeLog Date: Fri Feb 18 17:08:07 2005 Author: mbaringer From lgorrie at common-lisp.net Sun Feb 20 20:20:44 2005 From: lgorrie at common-lisp.net (Luke Gorrie) Date: Sun, 20 Feb 2005 21:20:44 +0100 (CET) Subject: [slime-cvs] CVS update: slime/swank-backend.lisp Message-ID: <20050220202044.5F0F68846F@common-lisp.net> Update of /project/slime/cvsroot/slime In directory common-lisp.net:/tmp/cvs-serv8361 Modified Files: swank-backend.lisp Log Message: Export compute-applicable-methods-using-classes. Date: Sun Feb 20 21:20:41 2005 Author: lgorrie Index: slime/swank-backend.lisp diff -u slime/swank-backend.lisp:1.78 slime/swank-backend.lisp:1.79 --- slime/swank-backend.lisp:1.78 Fri Feb 18 17:03:48 2005 +++ slime/swank-backend.lisp Sun Feb 20 21:20:39 2005 @@ -81,7 +81,9 @@ #:slot-definition-name #:slot-definition-type #:slot-definition-readers - #:slot-definition-writers)) + #:slot-definition-writers + ;; generic function protocol + #:compute-applicable-methods-using-classes)) (in-package :swank-backend) From lgorrie at common-lisp.net Sun Feb 20 20:29:20 2005 From: lgorrie at common-lisp.net (Luke Gorrie) Date: Sun, 20 Feb 2005 21:29:20 +0100 (CET) Subject: [slime-cvs] CVS update: slime/swank.lisp Message-ID: <20050220202920.CD3A98846F@common-lisp.net> Update of /project/slime/cvsroot/slime In directory common-lisp.net:/tmp/cvs-serv8416 Modified Files: swank.lisp Log Message: (arglist): New struct for storing decoded arglists. (decode-arglist): New function. (arglist-keywords, methods-keywords, generic-function-keywords, applicable-methods-keywords): New functions. (decoded-arglist-to-template-string, print-decoded-arglist-as-template): New functions. (arglist-to-template-string): Rewrite using above functions. (remove-actual-args): New function. (complete-form): New slimefun. (extra-keywords): New generic function. (arglist-for-insertion): Use extra-keywords to enrich the list of keywords. (valid-operator-symbol-p): New function. (valid-operator-name-p): Use valid-operator-symbol-p. Date: Sun Feb 20 21:29:16 2005 Author: lgorrie Index: slime/swank.lisp diff -u slime/swank.lisp:1.279 slime/swank.lisp:1.280 --- slime/swank.lisp:1.279 Fri Feb 18 17:04:28 2005 +++ slime/swank.lisp Sun Feb 20 21:29:14 2005 @@ -1095,12 +1095,16 @@ default) default))) +(defun valid-operator-symbol-p (symbol) + "Test if SYMBOL names a function, macro, or special-operator." + (or (fboundp symbol) + (macro-function symbol) + (special-operator-p symbol))) + (defun valid-operator-name-p (string) "Test if STRING names a function, macro, or special-operator." (let ((symbol (parse-symbol string))) - (or (fboundp symbol) - (macro-function symbol) - (special-operator-p symbol)))) + (valid-operator-symbol-p symbol))) (defslimefun arglist-for-echo-area (names) "Return the arglist for the first function, macro, or special-op in NAMES." @@ -1221,51 +1225,224 @@ (assert (values-equal? (decode-optional-arg 'x) ('x nil))) (assert (values-equal? (decode-optional-arg '(x t)) ('x t)))) +(defstruct (arglist (:conc-name arglist.)) + required-args ; list of the required arguments + optional-args ; list of the optional arguments + keyword-args ; list of the keywords + rest ; name of the &rest or &body argument (if any) + body-p ; whether the rest argument is a &body + allow-other-keys-p) ; whether &allow-other-keys appeared + +(defun decode-arglist (arglist) + (let ((mode nil) + (result (make-arglist))) + (dolist (arg arglist) + (typecase arg + ((member &key &optional &rest &body &whole &aux) + (setq mode arg)) + ((member &allow-other-keys) + (setf (arglist.allow-other-keys-p result) t)) + (t + (case mode + (&key + (push (decode-keyword-arg arg) + (arglist.keyword-args result))) + (&optional + (push (decode-optional-arg arg) + (arglist.optional-args result))) + (&body + (setf (arglist.body-p result) t + (arglist.rest result) arg)) + (&rest + (setf (arglist.rest result) arg)) + ((nil) + (push arg (arglist.required-args result))))))) + (setf (arglist.required-args result) + (nreverse (arglist.required-args result))) + (setf (arglist.optional-args result) + (nreverse (arglist.optional-args result))) + (setf (arglist.keyword-args result) + (nreverse (arglist.keyword-args result))) + result)) + +(defun arglist-keywords (arglist) + "Return the list of keywords in ARGLIST. +As a secondary value, return whether &allow-other-keys appears." + (let ((decoded-arglist (decode-arglist arglist))) + (values (arglist.keyword-args decoded-arglist) + (arglist.allow-other-keys-p decoded-arglist)))) + +(defun methods-keywords (methods) + "Collect all keywords in the arglists of METHODS. +As a secondary value, return whether &allow-other-keys appears somewhere." + (let ((keywords '()) + (allow-other-keys nil)) + (dolist (method methods) + (multiple-value-bind (kw aok) + (arglist-keywords + (swank-mop:method-lambda-list method)) + (setq keywords (remove-duplicates (append keywords kw)) + allow-other-keys (or allow-other-keys aok)))) + (values keywords allow-other-keys))) + +(defun generic-function-keywords (generic-function) + "Collect all keywords in the methods of GENERIC-FUNCTION. +As a secondary value, return whether &allow-other-keys appears somewhere." + (methods-keywords + (swank-mop:generic-function-methods generic-function))) + +(defun applicable-methods-keywords (generic-function classes) + "Collect all keywords in the methods of GENERIC-FUNCTION that are +applicable for argument of CLASSES. As a secondary value, return +whether &allow-other-keys appears somewhere." + (methods-keywords + (swank-mop:compute-applicable-methods-using-classes generic-function classes))) + (defun arglist-to-template-string (arglist package) "Print the list ARGLIST for insertion as a template for a function call." - (setq arglist (clean-arglist arglist)) - (etypecase arglist - (null "()") - (cons - (with-output-to-string (*standard-output*) - (with-standard-io-syntax - (let ((*package* package) (*print-case* :downcase) - (*print-pretty* t) (*print-circle* nil) (*print-readably* nil) - (*print-level* 10) (*print-length* 20)) - (pprint-logical-block (nil nil :prefix "(" :suffix ")") - (arglist-to-template-string-aux arglist)))))))) + (decoded-arglist-to-template-string + (decode-arglist arglist) package)) -(defun arglist-to-template-string-aux (arglist) - (let ((mode nil)) - (loop - (let ((arg (pop arglist))) - (case arg - ((&key &optional &rest &body) - (setq mode arg)) - (t - (case mode - (&key (multiple-value-bind (key sym) (decode-keyword-arg arg) - (format t "~W ~A" key sym))) - (&optional (format t "[~A]" (decode-optional-arg arg))) - (&body (format t "~:@_~A..." arg)) - (&rest (format t "~A..." arg)) - (otherwise (princ arg))) - (unless (null arglist) - (write-char #\space))))) - (when (null arglist) (return)) - (pprint-newline :fill)))) +(defun decoded-arglist-to-template-string (decoded-arglist package &key (prefix "(") (suffix ")")) + (with-output-to-string (*standard-output*) + (with-standard-io-syntax + (let ((*package* package) (*print-case* :downcase) + (*print-pretty* t) (*print-circle* nil) (*print-readably* nil) + (*print-level* 10) (*print-length* 20)) + (pprint-logical-block (nil nil :prefix prefix :suffix suffix) + (print-decoded-arglist-as-template decoded-arglist)))))) + +(defun print-decoded-arglist-as-template (decoded-arglist) + (let ((first-p t)) + (flet ((space () + (unless first-p + (write-char #\space) + (pprint-newline :fill)) + (setq first-p nil))) + (dolist (arg (arglist.required-args decoded-arglist)) + (space) + (princ arg)) + (dolist (arg (arglist.optional-args decoded-arglist)) + (space) + (format t "[~A]" arg)) + (dolist (keyword (arglist.keyword-args decoded-arglist)) + (space) + (format t "~W ~A" keyword keyword)) + (when (and (arglist.rest decoded-arglist) + (or (not (arglist.keyword-args decoded-arglist)) + (arglist.allow-other-keys-p decoded-arglist))) + (if (arglist.body-p decoded-arglist) + (pprint-newline :mandatory) + (space)) + (format t "~A..." (arglist.rest decoded-arglist))))) + (pprint-newline :fill)) + +(defgeneric extra-keywords (operator &rest args) + (:documentation "Return a list of extra keywords of OPERATOR (a symbol) +when applied to the (unevaluated) ARGS.")) + +(defmethod extra-keywords (operator &rest args) + ;; default method + (declare (ignore args)) + (let ((symbol-function (symbol-function operator))) + (if (typep symbol-function 'generic-function) + (generic-function-keywords symbol-function) + nil))) + +(defmethod extra-keywords ((operator (eql 'make-instance)) + &rest args) + (unless (null args) + (let ((class-name-form (car args))) + (when (and (listp class-name-form) + (= (length class-name-form) 2) + (eq (car class-name-form) 'quote)) + (let* ((class-name (cadr class-name-form)) + (class (find-class class-name nil))) + (when class + ;; We have the case (make-instance 'CLASS ...) + ;; with a known CLASS. + (let ((slot-init-keywords + (loop for slot in (swank-mop:class-slots class) + append (swank-mop:slot-definition-initargs slot))) + (initialize-instance-keywords + (applicable-methods-keywords #'initialize-instance + (list class)))) + (return-from extra-keywords + (append slot-init-keywords + initialize-instance-keywords)))))))) + (call-next-method)) (defslimefun arglist-for-insertion (name) (with-buffer-syntax () - (cond ((valid-operator-name-p name) - (let ((arglist (arglist (parse-symbol name)))) - (etypecase arglist - ((member :not-available) + (let ((symbol (parse-symbol name))) + (cond + ((and symbol + (valid-operator-name-p name)) + (let ((arglist (arglist symbol))) + (etypecase arglist + ((member :not-available) :not-available) - (list - (arglist-to-template-string arglist *buffer-package*))))) - (t - :not-available)))) + (list + (let ((decoded-arglist (decode-arglist arglist)) + (extra-keywords (extra-keywords symbol))) + ;; enrich the list of keywords with the extra keywords + (setf (arglist.keyword-args decoded-arglist) + (remove-duplicates + (append (arglist.keyword-args decoded-arglist) + extra-keywords))) + (decoded-arglist-to-template-string decoded-arglist + *buffer-package*)))))) + (t + :not-available))))) + +(defun remove-actual-args (decoded-arglist actual-arglist) + "Remove from DECODED-ARGLIST the arguments that have already been +provided in ACTUAL-ARGLIST." + (loop while (and actual-arglist + (arglist.required-args decoded-arglist)) + do (progn (pop actual-arglist) + (pop (arglist.required-args decoded-arglist)))) + (loop while (and actual-arglist + (arglist.optional-args decoded-arglist)) + do (progn (pop actual-arglist) + (pop (arglist.optional-args decoded-arglist)))) + (loop for keyword in actual-arglist by #'cddr + do (setf (arglist.keyword-args decoded-arglist) + (delete keyword (arglist.keyword-args decoded-arglist))))) + +(defslimefun complete-form (form-string) + "Read FORM-STRING in the current buffer package, then complete it +by adding a template for the missing arguments." + (with-buffer-syntax () + (handler-case + (let ((form (read-from-string form-string))) + (when (consp form) + (let ((operator-form (first form)) + (argument-forms (rest form))) + (when (and (symbolp operator-form) + (valid-operator-symbol-p operator-form)) + (let ((arglist (arglist operator-form))) + (etypecase arglist + ((member :not-available) + :not-available) + (list + (let ((decoded-arglist (decode-arglist arglist)) + (extra-keywords (apply #'extra-keywords form))) + ;; enrich the list of keywords with the extra keywords + (setf (arglist.keyword-args decoded-arglist) + (remove-duplicates + (append (arglist.keyword-args decoded-arglist) + extra-keywords))) + ;; get rid of formal args already provided + (remove-actual-args decoded-arglist argument-forms) + (return-from complete-form + (decoded-arglist-to-template-string decoded-arglist + *buffer-package* + :prefix ""))))))))) + :not-available) + (reader-error (c) + (declare (ignore c)) + :not-available)))) ;;;; Evaluation From lgorrie at common-lisp.net Sun Feb 20 20:29:45 2005 From: lgorrie at common-lisp.net (Luke Gorrie) Date: Sun, 20 Feb 2005 21:29:45 +0100 (CET) Subject: [slime-cvs] CVS update: slime/slime.el Message-ID: <20050220202945.0F0FD8846F@common-lisp.net> Update of /project/slime/cvsroot/slime In directory common-lisp.net:/tmp/cvs-serv8449 Modified Files: slime.el Log Message: (slime-complete-form): New command. (slime-keys): Bind C-c C-s to slime-complete-form rather than slime-insert-arglist. Date: Sun Feb 20 21:29:44 2005 Author: lgorrie Index: slime/slime.el diff -u slime/slime.el:1.457 slime/slime.el:1.458 --- slime/slime.el:1.457 Fri Feb 18 17:01:53 2005 +++ slime/slime.el Sun Feb 20 21:29:43 2005 @@ -566,7 +566,7 @@ ("\M-g" slime-quit :prefixed t :inferior t :sldb t) ;; Documentation (" " slime-space :inferior t) - ("\C-s" slime-insert-arglist :prefixed t :inferior t) + ("\C-s" slime-complete-form :prefixed t :inferior t) ("\C-f" slime-describe-function :prefixed t :inferior t :sldb t) ("\M-d" slime-disassemble-symbol :prefixed t :inferior t :sldb t) ("\C-t" slime-toggle-trace-fdefinition :prefixed t :sldb t) @@ -4266,6 +4266,23 @@ (t (save-excursion (insert arglist)))))) + +(defun slime-complete-form () + "Complete the form at point. This is a superset of the +functionality of `slime-insert-arglist'." + (interactive) + ;; Find the (possibly incomplete) form around point. + (let* ((start (save-excursion (backward-up-list) (point))) + (end (point)) ; or try to find end (tricky)? + (form-string + (concat (buffer-substring-no-properties start end) ")"))) + (let ((result (slime-eval `(swank:complete-form ,form-string)))) + (if (eq result :not-available) + (error "Arglist not available") + (progn + (just-one-space) + (save-excursion + (insert result))))))) (defun slime-get-arglist (symbol-name) "Return the argument list for SYMBOL-NAME." From lgorrie at common-lisp.net Sun Feb 20 20:29:59 2005 From: lgorrie at common-lisp.net (Luke Gorrie) Date: Sun, 20 Feb 2005 21:29:59 +0100 (CET) Subject: [slime-cvs] CVS update: slime/ChangeLog Message-ID: <20050220202959.113958846F@common-lisp.net> Update of /project/slime/cvsroot/slime In directory common-lisp.net:/tmp/cvs-serv8475 Modified Files: ChangeLog Log Message: Date: Sun Feb 20 21:29:57 2005 Author: lgorrie Index: slime/ChangeLog diff -u slime/ChangeLog:1.611 slime/ChangeLog:1.612 --- slime/ChangeLog:1.611 Fri Feb 18 17:08:07 2005 +++ slime/ChangeLog Sun Feb 20 21:29:56 2005 @@ -1,3 +1,49 @@ +2005-02-20 Matthias Koeppe + + Supersede the command slime-insert-arglist with the new command + slime-complete-form and bind it to C-c C-s. The command completes + an incomplete form with a template for the missing arguments. + There is special code for discovering extra keywords of generic + functions and for handling make-instance. Examples: + + (subseq "abc" + --inserts--> start [end]) + (find 17 + --inserts--> sequence :from-end from-end :test test + :test-not test-not :start start :end end :key key) + (find 17 '(17 18 19) :test #'= + --inserts--> :from-end from-end + :test-not test-not :start start :end end :key key) + (defclass foo () ((bar :initarg :bar))) + (defmethod initialize-instance :after ((object foo) &key blub)) + (make-instance 'foo + --inserts--> :bar bar :blub blub initargs...) + + * swank.lisp (arglist): New struct for storing decoded arglists. + (decode-arglist): New function. + (arglist-keywords, methods-keywords, generic-function-keywords, + applicable-methods-keywords): New functions. + (decoded-arglist-to-template-string, + print-decoded-arglist-as-template): New functions. + (arglist-to-template-string): Rewrite using above functions. + (remove-actual-args): New function. + (complete-form): New slimefun. + + * swank.lisp (extra-keywords): New generic function. + + * swank-backend.lisp (:swank-mop package): + Export compute-applicable-methods-using-classes. + + * swank.lisp (arglist-for-insertion): Use extra-keywords to + enrich the list of keywords. + + * swank.lisp (valid-operator-symbol-p): New function. + (valid-operator-name-p): Use valid-operator-symbol-p. + + * slime.el (slime-complete-form): New command. + (slime-keys): Bind C-c C-s to slime-complete-form rather than + slime-insert-arglist. + 2005-02-18 Antonio Menezes Leitao Improve the trace mechanism (on lisps that support it). SLIME is @@ -122,7 +168,7 @@ make return values inspectable in the debugger. (signal-breakpoint): Initialize the new slot. -2005-01-19 Matthias Koeppe +2005-01-19 Matthias Koeppe * slime.el (slime-insert-arglist): Inserts a template for a function call instead of the plain arglist; this makes a @@ -205,7 +251,7 @@ * slime.el (slime-conservative-indentation): The default is now nil. Suggested by Travis Cross. -2005-01-10 Matthias Koeppe +2005-01-10 Matthias Koeppe * slime.el (slime-inspector-next-inspectable-object): Accept a prefix argument and make wrapping around more reliable. The code @@ -224,7 +270,7 @@ comint-completion-addsuffix so unambiguous or exact completion closes the string automatically. -2004-12-16 Matthias Koeppe +2004-12-16 Matthias Koeppe * slime.el (slime-keys): Bind M-* to slime-pop-find-definition-stack for compatibility with standard @@ -243,7 +289,7 @@ * swank.lisp (frame-for-emacs): Print the frame number a little nicer with ~2D. -2004-12-15 Matthias Koeppe +2004-12-15 Matthias Koeppe * slime.el (slime-lisp-modes): New variable to make C-c C-k customizable and usable in scheme-mode. @@ -1375,207 +1421,7 @@ slime-background-message. This displays multi-line arglists. (sldb-mode-map): Bind 'C' to sldb-inspect-condition. -2004-08-14 Helmut Eller - - * slime.el (slime-find-buffer-package): Use "%s", not "%S", to - avoid ugly escape characters, if the package name contains dots. - -2004-08-13 Luke Gorrie - - * slime.el (sldb-eval-in-frame): Print result to the REPL when a - prefix argument is given. - Added pull-down menus for SLDB and the REPL. - - * swank-source-path-parser.lisp: Removed caching of readtables and - the source-map hashtable. Fresh creation is ultra-cheap (<1ms). - The caching didn't handle modifications to readtables and - generally made me feel uneasy while tracking down an obscure bug - in a reader macro. - The cached source-map hashtable also wasn't thread-safe (ho hum). - -2004-08-13 Helmut Eller - - * slime.el (slime-merge-notes, slime-tree-for-note): Use the short - note message for annotation in the source buffer and the long - message in the tree widget. Used to be the other way around. - (sldb-insert-frames): Set the `start-open' property for XEmacs. - Without `start-open', the `point-entered' property is inherited - when we insert something before the "--more--" marker. Reported - by Sundar Narasimhan. - - * swank.lisp (variable-desc-for-echo-area): Bind some printer - variables to limit the length of the output. - -2004-08-05 Luke Gorrie - - * slime.el (slime-setup): Added typeout-frame keyword argument. - (slime-thread-attach): Fixed misnamed function call. - -2004-08-04 Luke Gorrie - - * swank-allegro.lisp (find-fspec-location): Fixed to work for more - types of definition than just functions. So M-. now works for e.g. - classes in Allegro. From Matthew Danish. - (find-fspec-location): Include the type of the definition in the - designator sent to Emacs. From Matthew Danish. - -2004-08-04 Martin Simmons - - * swank-lispworks.lisp (frame-actual-args): Correct syntax for - handler-case. - -2004-08-04 Helmut Eller - - * slime.el: (slime-mode-map, slime-repl-mode-map) - (slime-repl-read-mode-map): Remove the binding for C-c C-g. C-c - C-b is now the default interrupt key. - (slime-list-repl-short-cuts): Don't trash the shortcut-table: copy - it before sorting. (Thanks to Mark Simpson.) - -2004-08-02 Luke Gorrie - - * slime.el (slime-connect): Shorten the welcome message by leaving - out the port number (which is displayed in the REPL anyway). This - avoids line-wrapping some messages of encouragement. - - * swank.lisp (with-buffer-syntax): Don't bind *readtable* to - *buffer-readtable* if they are already EQ. When we shadow this - binding the user can't assign *readtable* from the REPL so it's - best avoided when possible. - - * swank-allegro.lisp: Removed fwrapper-based code for inheriting - "swankiness" to newly spawned threads. This was fighting the - system and not the right thing. - - * slime.el (slime-choose-overlay-region): Tweaked the - multiline-annotation-avoidance code to work with forms not - starting with an open-paren, e.g. `(..) or #'(..). - (slime-update-modeline-package): New configurable. Non-nil (the - default) means update the Lisp package in the modeline using an - idle timer. - (slime-repl-send-input): Make the `slime-repl-old-input' property - cover the whole input (including newline) so that pressing RET on - the end of an input line works. - Use a unique integer as the value of this property to distinguish - adjacent inputs. - (slime-current-package): Deal with narrowing. - -2004-08-01 Helmut Eller - - * swank-allegro.lisp (swank-compile-string): Use a temporary file - and set excl::*source-pathname* manually. This way we can find - the source buffer of functions compiled with C-c C-c. - (call-with-temp-file, compile-from-temp-file): New functions. - (list-callers, function-callers, in-constants-p) - (map-function-constants): Implements list callers by groveling - through the constants pools of named functions. - - * swank-lispworks.lisp: Minor refactoring. - -2004-07-30 Helmut Eller - - * slime.el (slime-connection): Say "No default connection - selected" if there are open connections but no default connection. - (slime-tree-indent-item): Point wasn't updated correctly if the - last line was empty. Use insert-before-markers instead of insert - to do it properly. - (slime-draw-connection-list): Don't break if there is no default - connection. - - * swank-cmucl.lisp (call-with-debugging-environment): Only handle - DI::UNHANDLED-CONDITION not all DI:DEBUG-CONDITIONs. - - * swank-backend.lisp (sldb-condition): Show the original condition - in the message. - -2004-07-28 Helmut Eller - - * slime.el (slime-eval-feature-conditional): Treat uppercase - operators NOT, AND, OR correctly. - (sldb-find-buffer): Remove killed buffers. - (sldb-quit): Raise an error if the RPC returns. - (slime-expected-failures): Delete unused function. - (complete-symbol): Test completion of - swank::compile-file. LispWorks has extra completions for - cl::compile-file. - (arglist): Test arglist of method cl:class-name. Add enough - regexpery to pass the test in most implementations. - - * swank-sbcl.lisp (list-callers, list-callees): Implemented. - -2004-07-26 Luke Gorrie - - * slime.el (slime-first-change-hook): Add `save-match-data' to - avoid breaking e.g. query-replace. Also added `save-excursion' - just to be safe. - - * README: s/setup-slime/slime-setup/ in the .emacs snippet. - -2004-07-23 Luke Gorrie - - * slime.el (slime-set-state): Show the message in the modeline in - the case where we aren't connected. Otherwise the "not connected" - status is ignored. - (slime-net-sentinel): Close the connection before changing the - status message. The old behaviour of this combined with the old - behaviour of `slime-set-state' could generally cause spurious - errors after a connection was closed. - -2004-07-22 Luke Gorrie - - * swank.lisp (carefully-find-package): Return *BUFFER-PACKAGE* if - no other package can be found. This is reverting a previous change - that broke completion in buffers with no known package. - - * slime.el (slime-maybe-start-lisp): Check that *inferior-lisp* - exists /and/ has a running process. Fixes a startup problem if - your inferior-lisp has died and you want to restart SLIME. - -2004-07-21 Luke Gorrie - - * slime.el (slime-sync-package-and-default-directory): Sync - `default-directory' in the REPL buffer too. - (slime-set-state): Convenience function for setting a connection's - state-name and updating the modeline if appropriate. This function - is called in the right places. - (slime-to-lisp-filename): Use `expand-file-name'. - -2004-07-20 Luke Gorrie - - * slime.el (slime-repl-update-banner): Restore old behaviour of - using an asynchronous evaluation to setup the REPL. This works - around a problem I'd reintroduced where the first REPL command - uses the wrong keymap. - -2004-07-20 Andreas Fuchs - - * swank-sbcl.lisp (call-with-compilation-hooks): Trap and report - errors that cause compilation to fail, e.g. read errors. - -2004-07-19 Luke Gorrie - - * HACKING: Updated. Some notes about Emacs features. - - * slime.el: More major refactoring. - Restructured and documented the networking and protocol code. - (slime-rex-continuations): Now connection-local. - -2004-07-18 Luke Gorrie - - * slime.el: Major refactoring. - Mostly resectioning and reordering definitions to try and improve - readability. - (slime-get-temp-buffer-create): New utility function to popup a - temporary buffer that automatically has a binding on `q' to - intelligently restore window configuration. Handy, but currently - not applicable to all of our temporary buffers. - (slime-with-chosen-connection): Removed this macro. Consequently - the compilation commands no longer prompt for which connection to - use when given a prefix argument. `slime-switch-to-output-buffer' - still works like that, but for other cases I think the - connection-list buffer is sufficient. - (slime-eval-async): New arglist: (form &optional cont pkg). If the - continuation is unspecified then the evaluation result is ignored, +2004-08-14 Helmut Eller - - * doc/slime.texi: New user manual. - - * swank.lisp (*communication-style*): New name for - *swank-in-background*. - Exported configuration variables: *communication-style*, - *log-events*, *use-dedicated-output-stream*. - -2004-03-20 Julian Stecklina - - * swank-sbcl.lisp (+o_async+, +f_setown+, +f_setfl+): Add correct - constants for FreeBSD. - -2004-03-19 Alan Shutko - - * swank.lisp, swank-loader.lisp: Take into account - `pathname-device' when deriving paths. A fix for Windows. - -2004-03-19 Luke Gorrie - - * slime.el (slime-connected-hook): New hook called each time SLIME - successfully connects to Lisp. This is handy for calling - `slime-ensure-typeout-frame', if you want to use that feature. - (sldb-print-condition): New command to print the SLDB condition - description into the REPL, for reference after SLDB exits. Can be - called from `sldb-hook' if you want the condition to always be - printed. Bound to 'P' in SLDB. - -2004-03-18 Helmut Eller - - * swank.lisp (format-values-for-echo-area): Bind *package* to - *buffer-package*. - (load-system-for-emacs): Renamed from swank-load-system. - (carefully-find-package): Be friendly to case inverting - readtables. - (inspect-current-condition): New function. - - * swank-backend.lisp, swank-cmucl.lisp (set-default-directory): - New backend function. - - * swank-allegro.lisp, swank-clisp.lisp, swank-lispworks.lisp, - swank-sbcl.lisp (swank-compile-string): Be friendly to - case-inverting readtables. - - * slime.el (sldb-inspect-condition): Use - swank:inspect-current-condition. - (slime-inspector-label-face): Make it bold by default. - (slime-check-protocol-version, slime-process-available-input): - Wait 2 secs after displaying the error message. - (sldb-list-catch-tags, sldb-show-frame-details): Display catch - tags as symbols not as strings. - -2004-03-16 Helmut Eller - - * slime.el (slime-dispatch-event, slime-rex): Pass a form instead - of a string with :emacs-rex. - (slime-connection-name): New connection variable. Use it in - various places instead of slime-lisp-implementation-type-name. - - * swank.lisp: Better symbol completion for case-inverting - readtables. (Thanks Thomas F. Burdick for suggestions.) - (output-case-converter): New function. - (find-matching-symbols): Case convert the symbol-name before - comparing. - (compound-prefix-match, prefix-match-p): Use char= instead of - char-equal. - (case-convert-input): Renamed from case-convert. - (eval-for-emacs): Renamed from eval-string. Take a form instead - of a string. - (dispatch-event, read-from-socket-io): Update callers. + bette (eval-region, interactive-eval): Use fresh-line to reset the column. 2004-03-13 Helmut Eller From lgorrie at common-lisp.net Sun Feb 20 23:08:57 2005 From: lgorrie at common-lisp.net (Luke Gorrie) Date: Mon, 21 Feb 2005 00:08:57 +0100 (CET) Subject: [slime-cvs] CVS update: slime/ChangeLog Message-ID: <20050220230857.285608846F@common-lisp.net> Update of /project/slime/cvsroot/slime In directory common-lisp.net:/tmp/cvs-serv17565 Modified Files: ChangeLog Log Message: Fixed removed comments! Date: Mon Feb 21 00:08:43 2005 Author: lgorrie Index: slime/ChangeLog diff -u slime/ChangeLog:1.612 slime/ChangeLog:1.613 --- slime/ChangeLog:1.612 Sun Feb 20 21:29:56 2005 +++ slime/ChangeLog Mon Feb 21 00:08:37 2005 @@ -1421,7 +1421,207 @@ slime-background-message. This displays multi-line arglists. (sldb-mode-map): Bind 'C' to sldb-inspect-condition. -2004-08-14 Helmut Eller + + * slime.el (slime-find-buffer-package): Use "%s", not "%S", to + avoid ugly escape characters, if the package name contains dots. + +2004-08-13 Luke Gorrie + + * slime.el (sldb-eval-in-frame): Print result to the REPL when a + prefix argument is given. + Added pull-down menus for SLDB and the REPL. + + * swank-source-path-parser.lisp: Removed caching of readtables and + the source-map hashtable. Fresh creation is ultra-cheap (<1ms). + The caching didn't handle modifications to readtables and + generally made me feel uneasy while tracking down an obscure bug + in a reader macro. + The cached source-map hashtable also wasn't thread-safe (ho hum). + +2004-08-13 Helmut Eller + + * slime.el (slime-merge-notes, slime-tree-for-note): Use the short + note message for annotation in the source buffer and the long + message in the tree widget. Used to be the other way around. + (sldb-insert-frames): Set the `start-open' property for XEmacs. + Without `start-open', the `point-entered' property is inherited + when we insert something before the "--more--" marker. Reported + by Sundar Narasimhan. + + * swank.lisp (variable-desc-for-echo-area): Bind some printer + variables to limit the length of the output. + +2004-08-05 Luke Gorrie + + * slime.el (slime-setup): Added typeout-frame keyword argument. + (slime-thread-attach): Fixed misnamed function call. + +2004-08-04 Luke Gorrie + + * swank-allegro.lisp (find-fspec-location): Fixed to work for more + types of definition than just functions. So M-. now works for e.g. + classes in Allegro. From Matthew Danish. + (find-fspec-location): Include the type of the definition in the + designator sent to Emacs. From Matthew Danish. + +2004-08-04 Martin Simmons + + * swank-lispworks.lisp (frame-actual-args): Correct syntax for + handler-case. + +2004-08-04 Helmut Eller + + * slime.el: (slime-mode-map, slime-repl-mode-map) + (slime-repl-read-mode-map): Remove the binding for C-c C-g. C-c + C-b is now the default interrupt key. + (slime-list-repl-short-cuts): Don't trash the shortcut-table: copy + it before sorting. (Thanks to Mark Simpson.) + +2004-08-02 Luke Gorrie + + * slime.el (slime-connect): Shorten the welcome message by leaving + out the port number (which is displayed in the REPL anyway). This + avoids line-wrapping some messages of encouragement. + + * swank.lisp (with-buffer-syntax): Don't bind *readtable* to + *buffer-readtable* if they are already EQ. When we shadow this + binding the user can't assign *readtable* from the REPL so it's + best avoided when possible. + + * swank-allegro.lisp: Removed fwrapper-based code for inheriting + "swankiness" to newly spawned threads. This was fighting the + system and not the right thing. + + * slime.el (slime-choose-overlay-region): Tweaked the + multiline-annotation-avoidance code to work with forms not + starting with an open-paren, e.g. `(..) or #'(..). + (slime-update-modeline-package): New configurable. Non-nil (the + default) means update the Lisp package in the modeline using an + idle timer. + (slime-repl-send-input): Make the `slime-repl-old-input' property + cover the whole input (including newline) so that pressing RET on + the end of an input line works. + Use a unique integer as the value of this property to distinguish + adjacent inputs. + (slime-current-package): Deal with narrowing. + +2004-08-01 Helmut Eller + + * swank-allegro.lisp (swank-compile-string): Use a temporary file + and set excl::*source-pathname* manually. This way we can find + the source buffer of functions compiled with C-c C-c. + (call-with-temp-file, compile-from-temp-file): New functions. + (list-callers, function-callers, in-constants-p) + (map-function-constants): Implements list callers by groveling + through the constants pools of named functions. + + * swank-lispworks.lisp: Minor refactoring. + +2004-07-30 Helmut Eller + + * slime.el (slime-connection): Say "No default connection + selected" if there are open connections but no default connection. + (slime-tree-indent-item): Point wasn't updated correctly if the + last line was empty. Use insert-before-markers instead of insert + to do it properly. + (slime-draw-connection-list): Don't break if there is no default + connection. + + * swank-cmucl.lisp (call-with-debugging-environment): Only handle + DI::UNHANDLED-CONDITION not all DI:DEBUG-CONDITIONs. + + * swank-backend.lisp (sldb-condition): Show the original condition + in the message. + +2004-07-28 Helmut Eller + + * slime.el (slime-eval-feature-conditional): Treat uppercase + operators NOT, AND, OR correctly. + (sldb-find-buffer): Remove killed buffers. + (sldb-quit): Raise an error if the RPC returns. + (slime-expected-failures): Delete unused function. + (complete-symbol): Test completion of + swank::compile-file. LispWorks has extra completions for + cl::compile-file. + (arglist): Test arglist of method cl:class-name. Add enough + regexpery to pass the test in most implementations. + + * swank-sbcl.lisp (list-callers, list-callees): Implemented. + +2004-07-26 Luke Gorrie + + * slime.el (slime-first-change-hook): Add `save-match-data' to + avoid breaking e.g. query-replace. Also added `save-excursion' + just to be safe. + + * README: s/setup-slime/slime-setup/ in the .emacs snippet. + +2004-07-23 Luke Gorrie + + * slime.el (slime-set-state): Show the message in the modeline in + the case where we aren't connected. Otherwise the "not connected" + status is ignored. + (slime-net-sentinel): Close the connection before changing the + status message. The old behaviour of this combined with the old + behaviour of `slime-set-state' could generally cause spurious + errors after a connection was closed. + +2004-07-22 Luke Gorrie + + * swank.lisp (carefully-find-package): Return *BUFFER-PACKAGE* if + no other package can be found. This is reverting a previous change + that broke completion in buffers with no known package. + + * slime.el (slime-maybe-start-lisp): Check that *inferior-lisp* + exists /and/ has a running process. Fixes a startup problem if + your inferior-lisp has died and you want to restart SLIME. + +2004-07-21 Luke Gorrie + + * slime.el (slime-sync-package-and-default-directory): Sync + `default-directory' in the REPL buffer too. + (slime-set-state): Convenience function for setting a connection's + state-name and updating the modeline if appropriate. This function + is called in the right places. + (slime-to-lisp-filename): Use `expand-file-name'. + +2004-07-20 Luke Gorrie + + * slime.el (slime-repl-update-banner): Restore old behaviour of + using an asynchronous evaluation to setup the REPL. This works + around a problem I'd reintroduced where the first REPL command + uses the wrong keymap. + +2004-07-20 Andreas Fuchs + + * swank-sbcl.lisp (call-with-compilation-hooks): Trap and report + errors that cause compilation to fail, e.g. read errors. + +2004-07-19 Luke Gorrie + + * HACKING: Updated. Some notes about Emacs features. + + * slime.el: More major refactoring. + Restructured and documented the networking and protocol code. + (slime-rex-continuations): Now connection-local. + +2004-07-18 Luke Gorrie + + * slime.el: Major refactoring. + Mostly resectioning and reordering definitions to try and improve + readability. + (slime-get-temp-buffer-create): New utility function to popup a + temporary buffer that automatically has a binding on `q' to + intelligently restore window configuration. Handy, but currently + not applicable to all of our temporary buffers. + (slime-with-chosen-connection): Removed this macro. Consequently + the compilation commands no longer prompt for which connection to + use when given a prefix argument. `slime-switch-to-output-buffer' + still works like that, but for other cases I think the + connection-list buffer is sufficient. + (slime-eval-async): New arglist: (form &optional cont pkg). If the + continuation is unspecified then the evaluation result is ignored, and if the package is unspecified then (slime-buffer-package) is used. (slime-eval): Package arg now defaults to (slime-buffer-package). @@ -3185,7 +3385,109 @@ (describe-symbol-for-emacs, describe-definition): Distinguish between ordinary and generic functions. (call-with-debugging-environment): Unwind a few frames. Looks - bette + better and avoids the problems with the real topframe. + (interesting-frame-p): Use Lispworks dbg:*print-xxx* variables to + decide which frames are interesting. + (frame-actual-args): New function. + (print-frame): Use it. + + * swank.lisp (open-streams, make-output-function): Capture the + connection not only the socket. This way the streams can be used + from unrelated threads. Reported by Alain Picard. + (create-connection): Factorized. Initialize the streams after the + connection is created. + (initialize-streams-for-connection, spawn-threads-for-connection): + New functions. + (with-connection): Fix quoting bug and move upwards before first + use. + (guess-package-from-string): Add kludge for SBCL !-package names. + (apropos-list-for-emacs): Lispworks apparently returns duplicates; + remove them. + (inspect-object): Princ the label to allow strings and symbols. + (send-output-to-emacs): Deleted. + (defslimefun-unimplemented): Deleted. Was unused. + + * slime.el (slime-easy-menu): Add some more commands. + (slime-changelog-date): New variable. Initialized with the value + returned by the function of the same name. This detects + incompatible versions if Emacs has not been restarted after an + upgrade. + (slime-check-protocol-version, slime-init-output-buffer): Use it. + (slime-events-buffer, slime-log-event): Use fundamental mode + instead of lisp-mode to avoid excessive font-locking for messages + with lots of strings. + +2004-03-22 Luke Gorrie + + * doc/slime.texi: New user manual. + + * swank.lisp (*communication-style*): New name for + *swank-in-background*. + Exported configuration variables: *communication-style*, + *log-events*, *use-dedicated-output-stream*. + +2004-03-20 Julian Stecklina + + * swank-sbcl.lisp (+o_async+, +f_setown+, +f_setfl+): Add correct + constants for FreeBSD. + +2004-03-19 Alan Shutko + + * swank.lisp, swank-loader.lisp: Take into account + `pathname-device' when deriving paths. A fix for Windows. + +2004-03-19 Luke Gorrie + + * slime.el (slime-connected-hook): New hook called each time SLIME + successfully connects to Lisp. This is handy for calling + `slime-ensure-typeout-frame', if you want to use that feature. + (sldb-print-condition): New command to print the SLDB condition + description into the REPL, for reference after SLDB exits. Can be + called from `sldb-hook' if you want the condition to always be + printed. Bound to 'P' in SLDB. + +2004-03-18 Helmut Eller + + * swank.lisp (format-values-for-echo-area): Bind *package* to + *buffer-package*. + (load-system-for-emacs): Renamed from swank-load-system. + (carefully-find-package): Be friendly to case inverting + readtables. + (inspect-current-condition): New function. + + * swank-backend.lisp, swank-cmucl.lisp (set-default-directory): + New backend function. + + * swank-allegro.lisp, swank-clisp.lisp, swank-lispworks.lisp, + swank-sbcl.lisp (swank-compile-string): Be friendly to + case-inverting readtables. + + * slime.el (sldb-inspect-condition): Use + swank:inspect-current-condition. + (slime-inspector-label-face): Make it bold by default. + (slime-check-protocol-version, slime-process-available-input): + Wait 2 secs after displaying the error message. + (sldb-list-catch-tags, sldb-show-frame-details): Display catch + tags as symbols not as strings. + +2004-03-16 Helmut Eller + + * slime.el (slime-dispatch-event, slime-rex): Pass a form instead + of a string with :emacs-rex. + (slime-connection-name): New connection variable. Use it in + various places instead of slime-lisp-implementation-type-name. + + * swank.lisp: Better symbol completion for case-inverting + readtables. (Thanks Thomas F. Burdick for suggestions.) + (output-case-converter): New function. + (find-matching-symbols): Case convert the symbol-name before + comparing. + (compound-prefix-match, prefix-match-p): Use char= instead of + char-equal. + (case-convert-input): Renamed from case-convert. + (eval-for-emacs): Renamed from eval-string. Take a form instead + of a string. + (dispatch-event, read-from-socket-io): Update callers. (eval-region, interactive-eval): Use fresh-line to reset the column. 2004-03-13 Helmut Eller From heller at common-lisp.net Tue Feb 22 05:59:17 2005 From: heller at common-lisp.net (Helmut Eller) Date: Tue, 22 Feb 2005 06:59:17 +0100 (CET) Subject: [slime-cvs] CVS update: slime/swank-lispworks.lisp Message-ID: <20050222055917.57B9488677@common-lisp.net> Update of /project/slime/cvsroot/slime In directory common-lisp.net:/tmp/cvs-serv22156 Modified Files: swank-lispworks.lisp Log Message: (swank-mop:compute-applicable-methods-using-classes): Implement it. Date: Tue Feb 22 06:59:16 2005 Author: heller Index: slime/swank-lispworks.lisp diff -u slime/swank-lispworks.lisp:1.64 slime/swank-lispworks.lisp:1.65 --- slime/swank-lispworks.lisp:1.64 Tue Dec 21 14:49:30 2004 +++ slime/swank-lispworks.lisp Tue Feb 22 06:59:14 2005 @@ -27,13 +27,17 @@ (import-swank-mop-symbols :clos '(:slot-definition-documentation :eql-specializer - :eql-specializer-object)) + :eql-specializer-object + :compute-applicable-methods-using-classes)) (defun swank-mop:slot-definition-documentation (slot) (documentation slot t)) -;;;; lispworks doesn't have the eql-specializer class, it represents -;;;; them as a list of `(EQL ,OBJECT) +(defun swank-mop:compute-applicable-methods-using-classes (gf classes) + (clos::compute-applicable-methods-from-classes gf classes)) + +;; lispworks doesn't have the eql-specializer class, it represents +;; them as a list of `(EQL ,OBJECT) (deftype swank-mop:eql-specializer () 'cons) (defun swank-mop:eql-specializer-object (eql-spec) @@ -88,8 +92,8 @@ (defimplementation emacs-connected () (declare (ignore stream)) - (when (eq nil (symbol-value - (find-symbol (string :*communication-style*) :swank))) + (when (eq (symbol-value (find-symbol "*COMMUNICATION-STYLE*" :swank)) + nil) (set-sigint-handler)) (let ((lw:*handle-warn-on-redefinition* :warn)) (defmethod env-internals:environment-display-notifier From heller at common-lisp.net Tue Feb 22 06:04:09 2005 From: heller at common-lisp.net (Helmut Eller) Date: Tue, 22 Feb 2005 07:04:09 +0100 (CET) Subject: [slime-cvs] CVS update: slime/slime.el Message-ID: <20050222060409.CB1FB88677@common-lisp.net> Update of /project/slime/cvsroot/slime In directory common-lisp.net:/tmp/cvs-serv22943 Modified Files: slime.el Log Message: (slime-complete-form): Emacs 20 compatibility fix. (slime-repl-update-banner): Remove animation stuff. (slime-startup-animation): Deleted. Date: Tue Feb 22 07:04:08 2005 Author: heller Index: slime/slime.el diff -u slime/slime.el:1.458 slime/slime.el:1.459 --- slime/slime.el:1.458 Sun Feb 20 21:29:43 2005 +++ slime/slime.el Tue Feb 22 07:04:04 2005 @@ -108,11 +108,6 @@ :prefix "slime-" :group 'slime) -(defcustom slime-startup-animation t - "Enable the startup animation." - :type '(choice (const :tag "Enable" t) (const :tag "Disable" nil)) - :group 'slime-ui) - (defcustom slime-truncate-lines t "Set `truncate-lines' in popup buffers. This applies to buffers that present lines as rows of data, such as @@ -2329,18 +2324,9 @@ (slime-pid))) ;; Emacs21 has the fancy persistent header-line. (use-header-p (and slime-header-line-p - (boundp 'header-line-format))) - ;; and dancing text - (animantep (and (fboundp 'animate-string) - slime-startup-animation - (zerop (buffer-size))))) + (boundp 'header-line-format)))) (when use-header-p (setq header-line-format banner)) - (when animantep - (pop-to-buffer (current-buffer)) - (animate-string (format "; SLIME %s" (or (slime-changelog-date) - "- ChangeLog file not found")) - 0 0)) (slime-repl-insert-prompt (if use-header-p "" (concat "; " banner))))) (defun slime-changelog-date () @@ -4272,7 +4258,7 @@ functionality of `slime-insert-arglist'." (interactive) ;; Find the (possibly incomplete) form around point. - (let* ((start (save-excursion (backward-up-list) (point))) + (let* ((start (save-excursion (backward-up-list 1) (point))) (end (point)) ; or try to find end (tricky)? (form-string (concat (buffer-substring-no-properties start end) ")"))) From heller at common-lisp.net Tue Feb 22 06:06:59 2005 From: heller at common-lisp.net (Helmut Eller) Date: Tue, 22 Feb 2005 07:06:59 +0100 (CET) Subject: [slime-cvs] CVS update: slime/ChangeLog Message-ID: <20050222060659.C52DE88677@common-lisp.net> Update of /project/slime/cvsroot/slime In directory common-lisp.net:/tmp/cvs-serv23011 Modified Files: ChangeLog Log Message: *** empty log message *** Date: Tue Feb 22 07:06:58 2005 Author: heller Index: slime/ChangeLog diff -u slime/ChangeLog:1.613 slime/ChangeLog:1.614 --- slime/ChangeLog:1.613 Mon Feb 21 00:08:37 2005 +++ slime/ChangeLog Tue Feb 22 07:06:58 2005 @@ -1,3 +1,12 @@ +2005-02-22 Helmut Eller + + * slime.el (slime-complete-form): Emacs 20 compatibility fix. + (slime-repl-update-banner): Remove animation stuff. + (slime-startup-animation): Deleted. + + * swank-lispworks.lisp (compute-applicable-methods-using-classes): + Implement it. + 2005-02-20 Matthias Koeppe Supersede the command slime-insert-arglist with the new command From heller at common-lisp.net Tue Feb 22 06:27:18 2005 From: heller at common-lisp.net (Helmut Eller) Date: Tue, 22 Feb 2005 07:27:18 +0100 (CET) Subject: [slime-cvs] CVS update: slime/swank-allegro.lisp Message-ID: <20050222062718.A7A0A88677@common-lisp.net> Update of /project/slime/cvsroot/slime In directory common-lisp.net:/tmp/cvs-serv23859 Modified Files: swank-allegro.lisp Log Message: (restart-frame): Simplify it a little. (toggle-trace-generic-function-methods): Minor reformatting. Date: Tue Feb 22 07:27:17 2005 Author: heller Index: slime/swank-allegro.lisp diff -u slime/swank-allegro.lisp:1.68 slime/swank-allegro.lisp:1.69 --- slime/swank-allegro.lisp:1.68 Fri Feb 18 17:03:35 2005 +++ slime/swank-allegro.lisp Tue Feb 22 07:27:17 2005 @@ -204,9 +204,10 @@ (defimplementation restart-frame (frame-number) (let ((frame (nth-frame frame-number))) - (apply #'debugger:frame-retry - (append (list frame (debugger:frame-function frame)) - (cdr (debugger:frame-expression frame)))))) + (cond ((debugger:frame-retryable-p frame) + (apply #'debugger:frame-retry frame (debugger:frame-function frame) + (cdr (debugger:frame-expression frame)))) + (t "Frame is not retryable")))) ;;;; Compiler hooks @@ -664,7 +665,7 @@ (defimplementation quit-lisp () (excl:exit 0 :quiet t)) -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + ;;Trace implementations ;;In Allegro 7.0, we have: ;; (trace ) @@ -673,6 +674,7 @@ ;; (trace ((labels (method (+)) ))) ;; can be a normal name or a (setf name) +#-allegro-v5.0 (defimplementation toggle-trace-generic-function-methods (name) (let ((methods (mop:generic-function-methods (fdefinition name)))) (cond ((member name (eval '(trace)) :test #'equal) @@ -698,8 +700,10 @@ (ecase (first fspec) ((:defun :defgeneric) (second fspec)) ((:defmethod) `(method ,@(rest fspec))) - ((:labels) `(labels ,(process-fspec-for-allegro (second fspec)) ,(third fspec))) - ((:flet) `(flet ,(process-fspec-for-allegro (second fspec)) ,(third fspec))))) + ((:labels) `(labels ,(process-fspec-for-allegro (second fspec)) + ,(third fspec))) + ((:flet) `(flet ,(process-fspec-for-allegro (second fspec)) + ,(third fspec))))) (t fspec))) From heller at common-lisp.net Wed Feb 23 13:10:15 2005 From: heller at common-lisp.net (Helmut Eller) Date: Wed, 23 Feb 2005 14:10:15 +0100 (CET) Subject: [slime-cvs] CVS update: slime/slime.el Message-ID: <20050223131015.E5C2588666@common-lisp.net> Update of /project/slime/cvsroot/slime In directory common-lisp.net:/tmp/cvs-serv28658 Modified Files: slime.el Log Message: (slime-startup-animation, slime-repl-update-banner): Put the animation back in to keep the kids quiet. (slime-kill-without-query-p): Change default to nil. (slime-eval-describe, slime-eval-region) (slime-pprint-eval-last-expression): Fix typos in docstrings. (slime-eval/compile-defun-dwim): Deleted. We never had a key binding anyway. Date: Wed Feb 23 14:10:10 2005 Author: heller Index: slime/slime.el diff -u slime/slime.el:1.459 slime/slime.el:1.460 --- slime/slime.el:1.459 Tue Feb 22 07:04:04 2005 +++ slime/slime.el Wed Feb 23 14:10:10 2005 @@ -121,12 +121,17 @@ :type 'boolean :group 'slime-ui) -(defcustom slime-kill-without-query-p t +(defcustom slime-kill-without-query-p nil "If non-nil, kill SLIME processes without query when quitting Emacs. This applies to the *inferior-lisp* buffer and the network connections." :type 'boolean :group 'slime-ui) +(defcustom slime-startup-animation t + "Enable the startup animation." + :type '(choice (const :tag "Enable" t) (const :tag "Disable" nil)) + :group 'slime-ui) + ;;;;; slime-lisp (defgroup slime-lisp nil @@ -2324,9 +2329,18 @@ (slime-pid))) ;; Emacs21 has the fancy persistent header-line. (use-header-p (and slime-header-line-p - (boundp 'header-line-format)))) + (boundp 'header-line-format))) + ;; and dancing text + (animantep (and (fboundp 'animate-string) + slime-startup-animation + (zerop (buffer-size))))) (when use-header-p (setq header-line-format banner)) + (when animantep + (pop-to-buffer (current-buffer)) + (animate-string (format "; SLIME %s" (or (slime-changelog-date) + "- ChangeLog file not found")) + 0 0)) (slime-repl-insert-prompt (if use-header-p "" (concat "; " banner))))) (defun slime-changelog-date () @@ -5184,7 +5198,7 @@ (slime-show-last-output)))))) (defun slime-eval-describe (form) - "Evalute FORM in Lisp and display the result in a new buffer." + "Evaluate FORM in Lisp and display the result in a new buffer." (lexical-let ((package (slime-current-package))) (slime-eval-with-transcript form (lambda (string) (slime-show-description string package))))) @@ -5243,14 +5257,14 @@ (slime-interactive-eval form))))) (defun slime-eval-region (start end) - "Evalute region." + "Evaluate region." (interactive "r") (slime-eval-with-transcript `(swank:interactive-eval-region ,(buffer-substring-no-properties start end)))) (defun slime-eval-buffer () - "Evalute the current buffer. + "Evaluate the current buffer. The value is printed in the echo area." (interactive) (slime-eval-region (point-min) (point-max))) @@ -5263,48 +5277,26 @@ (slime-eval-with-transcript `(swank:re-evaluate-defvar ,form))) (defun slime-pprint-eval-last-expression () - "Evalute the form before point; pprint the value in a buffer." + "Evaluate the form before point; pprint the value in a buffer." (interactive) (slime-eval-describe `(swank:pprint-eval ,(slime-last-expression)))) (defun slime-eval-print-last-expression (string) - "Evalute sexp before point; print value into the current buffer" + "Evaluate sexp before point; print value into the current buffer" (interactive (list (slime-last-expression))) (insert "\n") (slime-eval-print string)) -(defun slime-eval/compile-defun-dwim (&optional arg) - "Call the computation command you want (Do What I Mean). -Look at defun and determine whether to call `slime-eval-defun' or -`slime-compile-defun'. - -A prefix of `-' forces evaluation, any other prefix forces -compilation." - (interactive "P") - (case arg - ;; prefix is `-', evaluate defun - ((-) (slime-eval-defun)) - ;; no prefix, automatically determine action - ((nil) (let ((form (slime-defun-at-point))) - (cond ((string-match "^(defvar " form) - (slime-re-evaluate-defvar form)) - ((string-match "^(def" form) - (slime-compile-defun)) - (t - (slime-eval-defun))))) - ;; prefix is not `-', compile defun - (otherwise (slime-compile-defun)))) - ;;This is an extension for the trace command. ;;Several interesting cases (the . shows the point position): -;; (defun n.ame (...) ...) -> (:defun name) -;; (defun (setf n.ame) (...) ...) -> (:defun (setf name)) -;; (defmethod n.ame (...) ...) -> (:defmethod name (...)) -;; (defun ... (...) (labels ((n.ame (...) ...) ...) ...)...) -> (:labels (:defun ...) name) -;; (defun ... (...) (flet ((n.ame (...) ...) ...) ...)...) -> (:flet (:defun ...) name) -;; (defun ... (...) ... (n.ame ...) ...) -> (:call (:defun ...) name) -;; (defun ... (...) ... (setf (n.ame ...) ...)) -> (:call (:defun ...) (setf name)) +;; (defun n.ame (...) ...) -> (:defun name) +;; (defun (setf n.ame) (...) ...) -> (:defun (setf name)) +;; (defmethod n.ame (...) ...) -> (:defmethod name (...)) +;; (defun ... (...) (labels ((n.ame (...) -> (:labels (:defun ...) name) +;; (defun ... (...) (flet ((n.ame (...) -> (:flet (:defun ...) name) +;; (defun ... (...) ... (n.ame ...) ...) -> (:call (:defun ...) name) +;; (defun ... (...) ... (setf (n.ame ...) -> (:call (:defun ...) (setf name)) ;; All other context should be identified as normal, traditional, ;; function calls. @@ -5321,28 +5313,31 @@ (defun name-context-at-point (name) (out-first 1) - (cond ((looking-at "defun") ;;a function definition + (cond ((looking-at "defun") ;a function definition `(:defun ,name)) - ((looking-at "defmacro") ;;a macro definition + ((looking-at "defmacro") ;a macro definition `(:defmacro ,name)) - ((looking-at "defgeneric") ;;a defgeneric form, maybe trace all methods + ((looking-at "defgeneric") ;a defgeneric form, maybe trace all methods `(:defgeneric ,name)) - ((looking-at "defmethod") ;;a defmethod, maybe trace just this method - (forward-sexp 3) ;;jump defmethod, name, and possibly, arglist + ((looking-at "defmethod") ;a defmethod, maybe trace just this method + (forward-sexp 3) ;jump defmethod, name, and possibly, arglist (let ((qualifier - (if (= (or (char-before) -1) ?\)) ;;ok, after arglist + (if (= (or (char-before) -1) ?\)) ;ok, after arglist (progn (forward-sexp -1) (list)) - (list (read (current-buffer))))) ;;it was a qualifier + (list (read (current-buffer))))) ;it was a qualifier (arglist (read (current-buffer)))) `(:defmethod ,name , at qualifier ,(parameter-specializers arglist)))) - ((looking-at "setf ") ;;looks like a setf-definition, but which? + ((looking-at "setf ") ;looks like a setf-definition, but which? (up-list -1) (name-context-at-point `(setf ,name))) - ((and (symbolp name) (looking-at (symbol-name name))) ;;the name itself, we need further investigation + ((and (symbolp name) + (looking-at (symbol-name name))) ;the name itself, we + ;need further + ;investigation (out-first 2) - (cond ((looking-at "setf ") ;;a setf-call + (cond ((looking-at "setf ") ;a setf-call (let ((def (ignore-errors (definition-name)))) (if def `(:call ,def (setf ,name)) @@ -5408,34 +5403,42 @@ (slime-toggle-trace-within spec))))))) (defun slime-toggle-trace-function (name) - (let ((real-name (slime-read-from-minibuffer "(Un)trace: " (prin1-to-string name)))) - (message "%s" (slime-eval `(swank:toggle-trace-function (swank::from-string ,real-name)))))) + (let ((real-name (slime-read-from-minibuffer "(Un)trace: " + (prin1-to-string name)))) + (message "%s" (slime-eval `(swank:toggle-trace-function + (swank::from-string ,real-name)))))) (defun slime-toggle-trace-defgeneric (name) (let ((name (prin1-to-string name))) (let ((real-name (slime-read-from-minibuffer "(Un)trace: " name))) (if (and (string= name real-name) - (y-or-n-p (format "(Un)trace also all methods implementing %s " real-name))) - (message "%s" (slime-eval `(swank:toggle-trace-generic-function-methods - (swank::from-string ,real-name)))) + (y-or-n-p (format "(Un)trace also all methods implementing %s " + real-name))) + (message "%s" (slime-eval `(swank:toggle-trace-generic-function-methods + (swank::from-string ,real-name)))) (message "%s" (slime-eval `(swank:toggle-trace-function (swank::from-string ,real-name)))))))) (defun slime-toggle-trace-defmethod (spec) - (let ((real-name (slime-read-from-minibuffer "(Un)trace: " (prin1-to-string spec)))) - (message "%s" (slime-eval `(swank:toggle-trace-method (swank::from-string ,real-name)))))) + (let ((real-name (slime-read-from-minibuffer "(Un)trace: " + (prin1-to-string spec)))) + (message "%s" (slime-eval `(swank:toggle-trace-method + (swank::from-string ,real-name)))))) (defun slime-toggle-trace-maybe-wherein (name wherein) - (let ((real-name (slime-read-from-minibuffer "(Un)trace: " (prin1-to-string name))) + (let ((real-name (slime-read-from-minibuffer "(Un)trace: " + (prin1-to-string name))) (wherein (prin1-to-string wherein))) (if (and (string= name real-name) - (y-or-n-p (format "(Un)trace only when %s call is made from %s " real-name wherein))) + (y-or-n-p (format "(Un)trace only when %s call is made from %s " + real-name wherein))) (message "%s" (slime-eval `(swank:toggle-trace-fdefinition-wherein (swank::from-string ,real-name) (swank::from-string ,wherein)))) (message "%s" (slime-eval `(swank:toggle-trace-fdefinition ,real-name)))))) (defun slime-toggle-trace-within (spec) - (let ((real-name (slime-read-from-minibuffer "(Un)trace local function: " (prin1-to-string spec)))) + (let ((real-name (slime-read-from-minibuffer "(Un)trace local function: " + (prin1-to-string spec)))) (message "%s" (slime-eval `(swank:toggle-trace-fdefinition-within (swank::from-string ,real-name)))))) From heller at common-lisp.net Wed Feb 23 13:13:19 2005 From: heller at common-lisp.net (Helmut Eller) Date: Wed, 23 Feb 2005 14:13:19 +0100 (CET) Subject: [slime-cvs] CVS update: slime/ChangeLog Message-ID: <20050223131319.CF7AE88666@common-lisp.net> Update of /project/slime/cvsroot/slime In directory common-lisp.net:/tmp/cvs-serv28720 Modified Files: ChangeLog Log Message: *** empty log message *** Date: Wed Feb 23 14:13:18 2005 Author: heller Index: slime/ChangeLog diff -u slime/ChangeLog:1.614 slime/ChangeLog:1.615 --- slime/ChangeLog:1.614 Tue Feb 22 07:06:58 2005 +++ slime/ChangeLog Wed Feb 23 14:13:18 2005 @@ -1,3 +1,13 @@ +2005-02-23 Helmut Eller + + * slime.el (slime-startup-animation, slime-repl-update-banner): + Put the animation back in to keep the kids quiet. + (slime-kill-without-query-p): Change default to nil. + (slime-eval-describe, slime-eval-region) + (slime-pprint-eval-last-expression): Fix typos in docstrings. + (slime-eval/compile-defun-dwim): Deleted. We never had a key + binding anyway. + 2005-02-22 Helmut Eller * slime.el (slime-complete-form): Emacs 20 compatibility fix. From heller at common-lisp.net Thu Feb 24 18:08:25 2005 From: heller at common-lisp.net (Helmut Eller) Date: Thu, 24 Feb 2005 19:08:25 +0100 (CET) Subject: [slime-cvs] CVS update: slime/swank.lisp Message-ID: <20050224180825.2F4788866D@common-lisp.net> Update of /project/slime/cvsroot/slime In directory common-lisp.net:/tmp/cvs-serv29206 Modified Files: swank.lisp Log Message: (eval-for-emacs): Use the new backend function call-with-debugger-hook. (eval-in-emacs): Cleaned up. Add support for synchronous RPCs. (receive-eval-result): New function. (dispatch-event, read-from-socket-io, send-to-socket-io): New :eval event. Rename :%apply to :eval-no-wait. (read-user-input-from-emacs, evaluate-in-emacs): Increment *read-input-catch-tag* instead of re-binding it. Reduces the danger of throwing to the wrong tag a bit. Date: Thu Feb 24 19:08:24 2005 Author: heller Index: slime/swank.lisp diff -u slime/swank.lisp:1.280 slime/swank.lisp:1.281 --- slime/swank.lisp:1.280 Sun Feb 20 21:29:14 2005 +++ slime/swank.lisp Thu Feb 24 19:08:24 2005 @@ -538,16 +538,21 @@ ((:read-string thread &rest args) (encode-message `(:read-string ,(thread-id thread) , at args) socket-io)) ((:evaluate-in-emacs string thread &rest args) - (encode-message `(:evaluate-in-emacs ,string ,(thread-id thread) , at args) socket-io)) + (encode-message `(:evaluate-in-emacs ,string ,(thread-id thread) , at args) + socket-io)) ((:read-aborted thread &rest args) (encode-message `(:read-aborted ,(thread-id thread) , at args) socket-io)) ((:emacs-return-string thread-id tag string) (send (find-thread thread-id) `(take-input ,tag ,string))) - (((:read-output :new-package :new-features :ed :%apply :indentation-update) + ((:eval thread &rest args) + (encode-message `(:eval ,(thread-id thread) , at args) socket-io)) + ((:emacs-return thread-id tag value) + (send (find-thread thread-id) `(take-input ,tag ,value))) + (((:read-output :new-package :new-features :ed :%apply :indentation-update + :eval-no-wait) &rest _) (declare (ignore _)) - (encode-message event socket-io)) - )) + (encode-message event socket-io)))) (defun spawn-threads-for-connection (connection) (let* ((socket-io (connection.socket-io connection)) @@ -644,7 +649,10 @@ '(simple-break)) ((:emacs-return-string thread tag string) (declare (ignore thread)) - `(take-input ,tag ,string))))) + `(take-input ,tag ,string)) + ((:emacs-return thread tag value) + (declare (ignore thread)) + `(take-input ,tag ,value))))) (defun send-to-socket-io (event) (log-event "DISPATCHING: ~S~%" event) @@ -652,7 +660,8 @@ (without-interrupts (encode-message o (current-socket-io))))) (destructure-case event - (((:debug-activate :debug :debug-return :read-string :read-aborted) + (((:debug-activate :debug :debug-return :read-string :read-aborted + :eval) thread &rest args) (declare (ignore thread)) (send `(,(car event) 0 , at args))) @@ -660,7 +669,7 @@ (declare (ignore thread)) (send `(:return , at args))) (((:read-output :new-package :new-features :debug-condition - :indentation-update :ed :%apply) + :indentation-update :ed :%apply :eval-no-wait) &rest _) (declare (ignore _)) (send event))))) @@ -941,36 +950,52 @@ (intern (format nil "~D" tag) :swank)) (defun read-user-input-from-emacs () - (let ((*read-input-catch-tag* (1+ *read-input-catch-tag*))) + (let ((tag (incf *read-input-catch-tag*))) (force-output) - (send-to-emacs `(:read-string ,(current-thread) ,*read-input-catch-tag*)) + (send-to-emacs `(:read-string ,(current-thread) ,tag)) (let ((ok nil)) (unwind-protect - (prog1 (catch (intern-catch-tag *read-input-catch-tag*) + (prog1 (catch (intern-catch-tag tag) (loop (read-from-emacs))) (setq ok t)) (unless ok - (send-to-emacs `(:read-aborted ,(current-thread) - *read-input-catch-tag*))))))) + (send-to-emacs `(:read-aborted ,(current-thread) ,tag))))))) (defslimefun take-input (tag input) "Return the string INPUT to the continuation TAG." (throw (intern-catch-tag tag) input)) - (defun evaluate-in-emacs (string) - (let ((*read-input-catch-tag* (1+ *read-input-catch-tag*))) + (let ((tag (incf *read-input-catch-tag*))) (force-output) - (send-to-emacs `(:evaluate-in-emacs ,string ,(current-thread) ,*read-input-catch-tag*)) + (send-to-emacs `(:evaluate-in-emacs ,string ,(current-thread) ,tag)) (let ((ok nil)) (unwind-protect - (prog1 (catch (intern-catch-tag *read-input-catch-tag*) + (prog1 (catch (intern-catch-tag tag) (loop (read-from-emacs))) (setq ok t)) (unless ok - (send-to-emacs `(:read-aborted ,(current-thread) - *read-input-catch-tag*))))))) + (send-to-emacs `(:read-aborted ,(current-thread) ,tag))))))) +(defun eval-in-emacs (form &optional nowait) + "Eval FORM in Emacs." + (destructuring-bind (fun &rest args) form + (let ((fun (string-downcase (string fun)))) + (cond (nowait + (send-to-emacs `(:eval-no-wait ,fun ,args))) + (t + (force-output) + (let* ((tag (incf *read-input-catch-tag*))) + (send-to-emacs `(:eval ,(current-thread) ,tag ,fun ,args)) + (receive-eval-result tag))))))) + +(defun receive-eval-result (tag) + (let ((value (catch (intern-catch-tag tag) + (loop (read-from-emacs))))) + (destructure-case value + ((:ok value) value) + ((:abort) (abort))))) + (defslimefun connection-info () "Return a list of the form: \(PID IMPLEMENTATION-TYPE IMPLEMENTATION-NAME FEATURES)." @@ -1296,7 +1321,8 @@ applicable for argument of CLASSES. As a secondary value, return whether &allow-other-keys appears somewhere." (methods-keywords - (swank-mop:compute-applicable-methods-using-classes generic-function classes))) + (swank-mop:compute-applicable-methods-using-classes + generic-function classes))) (defun arglist-to-template-string (arglist package) "Print the list ARGLIST for insertion as a template for a function call." @@ -1450,11 +1476,6 @@ (defvar *pending-continuations* '() "List of continuations for Emacs. (thread local)") -(defun eval-in-emacs (form) - "Execute FORM in Emacs." - (destructuring-bind (fn &rest args) form - (send-to-emacs `(:%apply ,(string-downcase (string fn)) ,args)))) - (defun guess-buffer-package (string) "Return a package for STRING. Fall back to the the current if no such package exists." @@ -1465,22 +1486,24 @@ "Bind *BUFFER-PACKAGE* BUFFER-PACKAGE and evaluate FORM. Return the result to the continuation ID. Errors are trapped and invoke our debugger." - (let ((*debugger-hook* #'swank-debugger-hook)) - (let (ok result) - (unwind-protect - (let ((*buffer-package* (guess-buffer-package buffer-package)) - (*buffer-readtable* (guess-buffer-readtable buffer-package)) - (*pending-continuations* (cons id *pending-continuations*))) - (assert (packagep *buffer-package*)) - (assert (readtablep *buffer-readtable*)) - (setq result (eval form)) - (force-output) - (run-hook *pre-reply-hook*) - (setq ok t)) - (force-user-output) - (send-to-emacs `(:return ,(current-thread) - ,(if ok `(:ok ,result) '(:abort)) - ,id)))))) + (call-with-debugger-hook + #'swank-debugger-hook + (lambda () + (let (ok result) + (unwind-protect + (let ((*buffer-package* (guess-buffer-package buffer-package)) + (*buffer-readtable* (guess-buffer-readtable buffer-package)) + (*pending-continuations* (cons id *pending-continuations*))) + (assert (packagep *buffer-package*)) + (assert (readtablep *buffer-readtable*)) + (setq result (eval form)) + (force-output) + (run-hook *pre-reply-hook*) + (setq ok t)) + (force-user-output) + (send-to-emacs `(:return ,(current-thread) + ,(if ok `(:ok ,result) '(:abort)) + ,id))))))) (defun format-values-for-echo-area (values) (with-buffer-syntax () From heller at common-lisp.net Thu Feb 24 18:09:00 2005 From: heller at common-lisp.net (Helmut Eller) Date: Thu, 24 Feb 2005 19:09:00 +0100 (CET) Subject: [slime-cvs] CVS update: slime/swank-lispworks.lisp Message-ID: <20050224180900.95F698866D@common-lisp.net> Update of /project/slime/cvsroot/slime In directory common-lisp.net:/tmp/cvs-serv29242 Modified Files: swank-lispworks.lisp Log Message: (slime-env): New class. (call-with-debugger-hook): Use env:with-environment to pop up our debugger on a BREAK. (toggle-trace-method, parse-fspec, tracedp, toggle-trace): Implement method tracing. Date: Thu Feb 24 19:09:00 2005 Author: heller Index: slime/swank-lispworks.lisp diff -u slime/swank-lispworks.lisp:1.65 slime/swank-lispworks.lisp:1.66 --- slime/swank-lispworks.lisp:1.65 Tue Feb 22 06:59:14 2005 +++ slime/swank-lispworks.lisp Thu Feb 24 19:08:59 2005 @@ -90,26 +90,6 @@ (sys::set-signal-handler +sigint+ (make-sigint-handler mp:*current-process*))) -(defimplementation emacs-connected () - (declare (ignore stream)) - (when (eq (symbol-value (find-symbol "*COMMUNICATION-STYLE*" :swank)) - nil) - (set-sigint-handler)) - (let ((lw:*handle-warn-on-redefinition* :warn)) - (defmethod env-internals:environment-display-notifier - (env &key restarts condition) - (declare (ignore restarts)) - (funcall (find-symbol (string :swank-debugger-hook) :swank) - condition *debugger-hook*)) - (defmethod env-internals:environment-display-debugger - (env) - *debug-io*))) - -(defimplementation make-stream-interactive (stream) - (let ((lw:*handle-warn-on-redefinition* :warn)) - (defmethod stream:stream-soft-force-output ((o (eql stream))) - (force-output o)))) - ;;; Unix signals (defun sigint-handler () @@ -217,6 +197,27 @@ ;;; Debugging +(defclass slime-env (env:environment) + ((debugger-hook :initarg :debugger-hoook))) + +(defun slime-env (hook io-bindings) + (make-instance 'slime-env :name "SLIME Environment" + :io-bindings io-bindings + :debugger-hoook hook)) + +(defmethod env-internals:environment-display-notifier + ((env slime-env) &key restarts condition) + (declare (ignore restarts)) + (funcall (slot-value env 'debugger-hook) condition *debugger-hook*)) + +(defmethod env-internals:environment-display-debugger ((env slime-env)) + *debug-io*) + +(defimplementation call-with-debugger-hook (hook fun) + (let ((*debugger-hook* hook)) + (env:with-environment ((slime-env hook '())) + (funcall fun)))) + (defvar *sldb-top-frame*) (defun interesting-frame-p (frame) @@ -571,6 +572,7 @@ (t `((,dspec (:error "Source location not available"))))))) (loop for dspec in dspecs append (frob-locs dspec (dspec:dspec-definition-locations dspec))))) + ;;; Inspector (defclass lispworks-inspector (inspector) ()) @@ -601,6 +603,27 @@ (defimplementation quit-lisp () (lispworks:quit)) +;;; Tracing + +(defun parse-fspec (fspec) + "Return a dspec for FSPEC." + (ecase (car fspec) + (:defmethod `(method ,@(cdr fspec))))) + +(defun tracedp (dspec) + (member dspec (eval '(trace)) :test #'equal)) + +(defun toggle-trace (dspec) + (cond ((tracedp dspec) + (eval `(untrace ,dspec)) + (format nil "~S is now untraced." dspec)) + (t + (eval `(trace (,dspec))) + (format nil "~S is now traced." dspec)))) + +(defimplementation toggle-trace-method (fspec) + (toggle-trace (parse-fspec fspec))) + ;;; Multithreading (defimplementation startup-multiprocessing () @@ -669,3 +692,23 @@ (defimplementation send (thread object) (mp:mailbox-send (mailbox thread) object)) +;;; Some intergration with the lispworks environment + +(defun swank-sym (name) (find-symbol (string name) (string :swank))) + +(defimplementation emacs-connected () + (when (eq (eval (swank-sym :*communication-style*)) + nil) + (set-sigint-handler))) + +(defimplementation make-stream-interactive (stream) + (unless (find-method #'stream:stream-soft-force-output nil `((eql ,stream)) + nil) + (let ((lw:*handle-warn-on-redefinition* :warn)) + (defmethod stream:stream-soft-force-output ((o (eql stream))) + (force-output o))))) + +(defmethod env-internals:confirm-p ((e slime-env) &optional msg &rest args) + (let ((prompt (cond (msg (apply #'format nil msg args)) + (t "")))) + (funcall (swank-sym :eval-in-emacs) `(y-or-n-p ,prompt)))) From heller at common-lisp.net Thu Feb 24 18:09:34 2005 From: heller at common-lisp.net (Helmut Eller) Date: Thu, 24 Feb 2005 19:09:34 +0100 (CET) Subject: [slime-cvs] CVS update: slime/swank-backend.lisp Message-ID: <20050224180934.49D588866D@common-lisp.net> Update of /project/slime/cvsroot/slime In directory common-lisp.net:/tmp/cvs-serv29263 Modified Files: swank-backend.lisp Log Message: (call-with-debugger-hook): New function. Useful if the backend needs special incantations for BREAK. (toggle-trace-function): Add a default implementation for simple symbols. Date: Thu Feb 24 19:09:33 2005 Author: heller Index: slime/swank-backend.lisp diff -u slime/swank-backend.lisp:1.79 slime/swank-backend.lisp:1.80 --- slime/swank-backend.lisp:1.79 Sun Feb 20 21:20:39 2005 +++ slime/swank-backend.lisp Thu Feb 24 19:09:33 2005 @@ -411,6 +411,13 @@ For example, this is a reasonable place to compute a backtrace, switch to safe reader/printer settings, and so on.") +(definterface call-with-debugger-hook (hook fun) + "Call FUN and use HOOK as debugger hook. + +HOOK should be called for both BREAK and INVOKE-DEBUGGER." + (let ((*debugger-hook* hook)) + (funcall fun))) + (define-condition sldb-condition (condition) ((original-condition :initarg :original-condition @@ -786,8 +793,10 @@ (definterface toggle-trace-function (spec) "Trace one function, including (setf name) forms." - (declare (ignore spec)) - "Sorry, function tracing has not yet been implemented on your platform.") + (cond ((symbolp spec) + (eval `(trace ,spec))) + (t + (format nil "Cannot trace fspec: ~S" spec)))) (definterface toggle-trace-generic-function-methods (name) "Trace the generic function and all methods of the generic function." @@ -795,7 +804,8 @@ "Sorry, generic function tracing has to yet been implemented on your platform.") (definterface toggle-trace-method (spec) - "Trace one method." + "Trace one method. +SPEC is if the form (:defmethod ,NAME , at QUALIFIERS (, at SPECIALIZERS))." (declare (ignore spec)) "Sorry, method tracing has not yet been implemented on your platform.") From heller at common-lisp.net Thu Feb 24 18:10:04 2005 From: heller at common-lisp.net (Helmut Eller) Date: Thu, 24 Feb 2005 19:10:04 +0100 (CET) Subject: [slime-cvs] CVS update: slime/swank-sbcl.lisp Message-ID: <20050224181004.B47BD8866D@common-lisp.net> Update of /project/slime/cvsroot/slime In directory common-lisp.net:/tmp/cvs-serv29283 Modified Files: swank-sbcl.lisp Log Message: (call-with-debugger-hook): Bind sb-ext:*invoke-debugger-hook* instead of setting it in emacs-connected. (emacs-connected): Deleted. Date: Thu Feb 24 19:10:02 2005 Author: heller Index: slime/swank-sbcl.lisp diff -u slime/swank-sbcl.lisp:1.117 slime/swank-sbcl.lisp:1.118 --- slime/swank-sbcl.lisp:1.117 Fri Feb 18 17:04:13 2005 +++ slime/swank-sbcl.lisp Thu Feb 24 19:10:02 2005 @@ -139,10 +139,6 @@ (return (sb-bsd-sockets:socket-accept socket)) (sb-bsd-sockets:interrupted-error ())))) -(defimplementation emacs-connected () - (setq sb-ext:*invoke-debugger-hook* - (find-symbol (string :swank-debugger-hook) (find-package :swank)))) - (defmethod call-without-interrupts (fn) (declare (type function fn)) (sb-sys:without-interrupts (funcall fn))) @@ -487,6 +483,10 @@ :original-condition condition))))) (funcall debugger-loop-fn)))) +(defimplementation call-with-debugger-hook (hook fun) + (let ((sb-ext:*invoke-debugger-hook* hook)) + (funcall fun))) + (defun nth-frame (index) (do ((frame *sldb-stack-top* (sb-di:frame-down frame)) (i index (1- i))) @@ -936,14 +936,13 @@ ) -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + ;;Trace implementations ;;In SBCL, we have: ;; (trace ) -;; (trace :methods ') ;;to trace all methods of the gf +;; (trace :methods ') ;to trace all methods of the gf ;; (trace (method ? (+))) ;; can be a normal name or a (setf name) - (defun toggle-trace (fspec &rest args) (cond ((member fspec (eval '(trace)) :test #'equal) From heller at common-lisp.net Thu Feb 24 18:10:42 2005 From: heller at common-lisp.net (Helmut Eller) Date: Thu, 24 Feb 2005 19:10:42 +0100 (CET) Subject: [slime-cvs] CVS update: slime/swank-loader.lisp Message-ID: <20050224181042.C0E7A8866D@common-lisp.net> Update of /project/slime/cvsroot/slime In directory common-lisp.net:/tmp/cvs-serv29311 Modified Files: swank-loader.lisp Log Message: (compile-files-if-needed-serially): Reduce verbosity by setting the :print argument for compile-file to nil. Date: Thu Feb 24 19:10:42 2005 Author: heller Index: slime/swank-loader.lisp diff -u slime/swank-loader.lisp:1.36 slime/swank-loader.lisp:1.37 --- slime/swank-loader.lisp:1.36 Sun Oct 3 14:10:48 2004 +++ slime/swank-loader.lisp Thu Feb 24 19:10:42 2005 @@ -73,9 +73,9 @@ (when (or needs-recompile (not (probe-file binary-pathname)) (file-newer-p source-pathname binary-pathname)) - (format t "~&;; Compiling ~A...~%" source-pathname) (ensure-directories-exist binary-pathname) - (compile-file source-pathname :output-file binary-pathname) + (compile-file source-pathname :output-file binary-pathname + :print nil :verbose t) (setq needs-recompile t)) (load binary-pathname :verbose t)) #+(or) @@ -100,4 +100,3 @@ (when (user-init-file) (load (user-init-file))) - From heller at common-lisp.net Thu Feb 24 18:17:49 2005 From: heller at common-lisp.net (Helmut Eller) Date: Thu, 24 Feb 2005 19:17:49 +0100 (CET) Subject: [slime-cvs] CVS update: slime/slime.el Message-ID: <20050224181749.70BED8866D@common-lisp.net> Update of /project/slime/cvsroot/slime In directory common-lisp.net:/tmp/cvs-serv30087 Modified Files: slime.el Log Message: (slime-dispatch-event): Add :eval-no-wait and :eval events. (slime-eval-for-lisp): New function. (sldb-buffers): Delete the variable. Use (buffer-list) instead. Date: Thu Feb 24 19:17:48 2005 Author: heller Index: slime/slime.el diff -u slime/slime.el:1.460 slime/slime.el:1.461 --- slime/slime.el:1.460 Wed Feb 23 14:10:10 2005 +++ slime/slime.el Thu Feb 24 19:17:48 2005 @@ -2208,8 +2208,12 @@ (slime-handle-indentation-update info)) ((:open-dedicated-output-stream port) (slime-open-stream-to-lisp port)) - ((:%apply fn args) - (apply (intern fn) args)) + ((:eval-no-wait fun args) + (apply (intern fun) args)) + ((:eval thread tag fun args) + (slime-eval-for-lisp thread tag (intern fun) args)) + ((:emacs-return thread tag value) + (slime-send `(:emacs-return ,thread ,tag ,value))) ((:ed what) (slime-ed what)) ((:debug-condition thread message) @@ -2224,7 +2228,7 @@ "Clear all pending continuations." (interactive) (setf (slime-rex-continuations) '()) - (mapc #'kill-buffer (mapcar #'cdr (sldb-remove-killed-buffers)))) + (mapc #'kill-buffer (sldb-buffers))) (defconst +slime-sigint+ 2) @@ -5114,6 +5118,19 @@ (add-hook 'slime-mode-hook 'slime-setup-first-change-hook) +;;;; Eval for Lisp + +(defun slime-eval-for-lisp (thread tag fun args) + (let ((ok nil) + (value nil) + (c (slime-connection))) + (unwind-protect (progn + (setq value (apply fun args)) + (setq ok t)) + (let ((result (if ok `(:ok ,value) `(:abort)))) + (slime-dispatch-event `(:emacs-return ,thread ,tag ,result)))))) + + ;;;; `ED' (defvar slime-ed-frame nil @@ -6155,34 +6172,37 @@ (defvar sldb-overlays '() "List of overlays created in source code buffers to highlight expressions.") -;; FIXME: Why are elements not of the form (connection thread buffer)? -(defvar sldb-buffers '() - "Alist of sldb-buffers of the form (((connection . thread) . buffer) ...)") - (defun sldb-buffers () - (setq sldb-buffers (remove-if-not #'buffer-live-p sldb-buffers :key #'cdr))) + (remove-if-not (lambda (buffer) + (with-current-buffer buffer + (eq major-mode 'sldb-mode))) + (buffer-list))) (defun sldb-find-buffer (thread) - (cdr (assoc* (cons (slime-connection) thread) (sldb-buffers) :test #'equal))) + (let ((connection (slime-connection))) + (find-if (lambda (buffer) + (with-current-buffer buffer + (and (eq slime-buffer-connection connection) + (eq slime-current-thread thread)))) + (sldb-buffers)))) (defun sldb-get-default-buffer () - (cdr (first (sldb-buffers)))) + "Get a sldb buffer. +The buffer is chosen more or less randomly." + (car (sldb-buffers))) (defun sldb-get-buffer (thread) + "Find or create a sldb-buffer for THREAD." (or (sldb-find-buffer thread) - (let* ((name (slime-connection-name)) - (buffer-name (format "*sldb %s/%s*" name thread)) - (buffer (get-buffer-create buffer-name))) - (push (cons (cons (slime-connection) thread) buffer) - sldb-buffers) - buffer))) + (get-buffer-create + (format "*sldb %s/%s*" (slime-connection-name) thread)))) (defun sldb-debugged-continuations (connection) "Return the debugged continuations for CONNECTION." (lexical-let ((accu '())) - (dolist (e (sldb-buffers)) - (when (eq (caar e) connection) - (with-current-buffer (cdr e) + (dolist (b (sldb-buffers)) + (with-current-buffer b + (when (eq slime-buffer-connection connection) (setq accu (append sldb-continuations accu))))) accu)) @@ -6237,7 +6257,6 @@ (erase-buffer)) (setq sldb-level nil)) (when (and (= level 1) (not stepping)) - (setf sldb-buffers (remove* sldb sldb-buffers :key #'cdr)) (kill-buffer sldb)))) (defun sldb-insert-condition (condition) @@ -8608,8 +8627,9 @@ (error "After quote")) (t (error "Shouldn't happen: parsing state: %S" state)))))) -(slime-defun-if-undefined read-directory-name (prompt &optional dir default-dirname - mustmatch initial) +(slime-defun-if-undefined read-directory-name (prompt + &optional dir default-dirname + mustmatch initial) (unless dir (setq dir default-directory)) (unless default-dirname From heller at common-lisp.net Thu Feb 24 18:18:11 2005 From: heller at common-lisp.net (Helmut Eller) Date: Thu, 24 Feb 2005 19:18:11 +0100 (CET) Subject: [slime-cvs] CVS update: slime/ChangeLog Message-ID: <20050224181811.BD7CC8866D@common-lisp.net> Update of /project/slime/cvsroot/slime In directory common-lisp.net:/tmp/cvs-serv30111 Modified Files: ChangeLog Log Message: *** empty log message *** Date: Thu Feb 24 19:18:11 2005 Author: heller Index: slime/ChangeLog diff -u slime/ChangeLog:1.615 slime/ChangeLog:1.616 --- slime/ChangeLog:1.615 Wed Feb 23 14:13:18 2005 +++ slime/ChangeLog Thu Feb 24 19:18:10 2005 @@ -1,3 +1,39 @@ +2005-02-24 Helmut Eller + + * slime.el (slime-dispatch-event): Add :eval-no-wait and :eval + events. + (slime-eval-for-lisp): New function. + (sldb-buffers): Delete the variable. Use buffer-list instead. + + * swank.lisp: (eval-for-emacs): Use the new backend function + call-with-debugger-hook. + (eval-in-emacs): Cleaned up. Add support for synchronous RPCs. + (receive-eval-result): New function. + (dispatch-event, read-from-socket-io, send-to-socket-io): New + :eval event. Rename :%apply to :eval-no-wait. + (read-user-input-from-emacs, evaluate-in-emacs): Increment + *read-input-catch-tag* instead of re-binding it. Reduces the + danger of throwing to the wrong tag a bit. + + * swank-backend.lisp (call-with-debugger-hook): New function. + Useful if the backend needs special incantations for BREAK. + (toggle-trace-function): Add a default implementation for simple + symbols. + + * swank-lispworks.lisp (slime-env): New class. + (call-with-debugger-hook): Use env:with-environment to pop up our + debugger on a BREAK. + (toggle-trace-method, parse-fspec, tracedp, toggle-trace): + Implement method tracing. + + * swank-sbcl.lisp (call-with-debugger-hook): Bind + sb-ext:*invoke-debugger-hook* instead of setting it in + emacs-connected. + (emacs-connected): Deleted. + + * swank-loader.lisp (compile-files-if-needed-serially): Reduce + verbosity by setting the :print argument for compile-file to nil. + 2005-02-23 Helmut Eller * slime.el (slime-startup-animation, slime-repl-update-banner): From lgorrie at common-lisp.net Sat Feb 26 10:39:26 2005 From: lgorrie at common-lisp.net (Luke Gorrie) Date: Sat, 26 Feb 2005 11:39:26 +0100 (CET) Subject: [slime-cvs] CVS update: slime/swank-cmucl.lisp Message-ID: <20050226103926.2628C8866B@common-lisp.net> Update of /project/slime/cvsroot/slime In directory common-lisp.net:/tmp/cvs-serv1056 Modified Files: swank-cmucl.lisp Log Message: (toggle-trace-method) (toggle-trace-fdefinition-wherein): Conditionalized for CMU19. Date: Sat Feb 26 11:39:22 2005 Author: lgorrie Index: slime/swank-cmucl.lisp diff -u slime/swank-cmucl.lisp:1.138 slime/swank-cmucl.lisp:1.139 --- slime/swank-cmucl.lisp:1.138 Fri Feb 18 17:03:59 2005 +++ slime/swank-cmucl.lisp Sat Feb 26 11:39:22 2005 @@ -2212,9 +2212,11 @@ (defimplementation toggle-trace-function (spec) (toggle-trace spec)) +#+cmu19 (defimplementation toggle-trace-method (spec) (toggle-trace `(pcl:fast-method ,@(rest (process-fspec spec))))) +#+cmu19 (defimplementation toggle-trace-fdefinition-wherein (name wherein) (toggle-trace name :wherein (process-fspec wherein))) From heller at common-lisp.net Mon Feb 28 23:29:55 2005 From: heller at common-lisp.net (Helmut Eller) Date: Tue, 1 Mar 2005 00:29:55 +0100 (CET) Subject: [slime-cvs] CVS update: slime/slime.el Message-ID: <20050228232955.C20A6884E2@common-lisp.net> Update of /project/slime/cvsroot/slime In directory common-lisp.net:/tmp/cvs-serv6487 Modified Files: slime.el Log Message: (slime-who-bindings): Bind who-specializes to C-c W a. (slime-extract-context): Renamed from name-context-at-point. (slime-beginning-of-list): Renamed from out-first. (slime-slime-parse-toplevel-form): Renamed from definition-name. (slime-arglist-specializers): Renamed from parameter-specializers. (slime-toggle-trace-function, slime-toggle-trace-defgeneric) (slime-toggle-trace-defmethod, slime-toggle-trace-maybe-wherein) (slime-toggle-trace-within): Deleted. Everything is now handeled by slime-trace-query. (slime-calls-who): For symmetry with silme-who-calls. (slime-edit-definition-with-etags): Better intergration with TAGS. (slime-edit-definition-fallback-function): Mention it in the docstring. Date: Tue Mar 1 00:29:49 2005 Author: heller Index: slime/slime.el diff -u slime/slime.el:1.461 slime/slime.el:1.462 --- slime/slime.el:1.461 Thu Feb 24 19:17:48 2005 +++ slime/slime.el Tue Mar 1 00:29:42 2005 @@ -183,9 +183,13 @@ "Function to call when edit-definition fails to find the source itself. The function is called with the definition name, a string, as its argument. -If you want to fallback on TAGS you can set this to `find-tag'." +If you want to fallback on TAGS you can set this to `find-tags' or +`slime-edit-definition-with-etags'." :type 'symbol - :group 'slime-mode-mode) + :group 'slime-mode-mode + :options '(nil + slime-edit-definition-with-etags + find-tags)) (defcustom slime-compilation-finished-hook 'slime-maybe-list-compiler-notes "Hook called with a list of compiler notes after a compilation." @@ -615,10 +619,12 @@ (defvar slime-who-bindings '((?c slime-who-calls) + (?w slime-calls-who) (?r slime-who-references) (?b slime-who-binds) (?s slime-who-sets) - (?m slime-who-macroexpands))) + (?m slime-who-macroexpands) + (?a slime-who-specializes))) ;; Maybe a good idea, maybe not.. (defvar slime-prefix-key "\C-c" @@ -4003,7 +4009,7 @@ "Move to the source location LOCATION. Several kinds of locations are supported: - ::= (:location ) + ::= (:location ) | (:error ) ::= (:file ) @@ -5035,10 +5041,11 @@ (defvar slime-find-definition-history-ring (make-ring 20) "History ring recording the definition-finding \"stack\".") -(defun slime-push-definition-stack () +(defun slime-push-definition-stack (&optional mark) "Add MARKER to the edit-definition history stack. If MARKER is nil, use the point." - (ring-insert-at-beginning slime-find-definition-history-ring (point-marker))) + (ring-insert-at-beginning slime-find-definition-history-ring + (or mark (point-marker)))) (defun slime-pop-find-definition-stack () "Pop the edit-definition stack and goto the location." @@ -5066,18 +5073,21 @@ (if slime-edit-definition-fallback-function (funcall slime-edit-definition-fallback-function name) (error "No known definition for: %s" name)) - (slime-push-definition-stack) - (cond ((slime-length> definitions 1) - (slime-show-definitions name definitions)) - (t - (slime-goto-source-location (slime-definition.location - (car definitions))) - (cond ((equal where 'window) - (switch-to-buffer-other-window (current-buffer))) - ((equal where 'frame) - (switch-to-buffer-other-frame (current-buffer))) - (t - (switch-to-buffer (current-buffer))))))))) + (slime-goto-definition name definitions where)))) + +(defun slime-goto-definition (name definitions &optional where) + (slime-push-definition-stack) + (cond ((slime-length> definitions 1) + (slime-show-definitions name definitions)) + (t + (slime-goto-source-location (slime-definition.location + (car definitions))) + (cond ((equal where 'window) + (switch-to-buffer-other-window (current-buffer))) + ((equal where 'frame) + (switch-to-buffer-other-frame (current-buffer))) + (t + (switch-to-buffer (current-buffer))))))) (defun slime-edit-definition-other-window (name) "Like `slime-edit-definition' but switch to the other window." @@ -5089,6 +5099,35 @@ (interactive (list (slime-read-symbol-name "Symbol: "))) (slime-edit-definition name 'frame)) +(defun slime-edit-definition-with-etags (name) + (interactive (list (slime-read-symbol-name "Symbol: "))) + (let ((tagdefs (slime-etags-definitions name))) + (cond (tagdefs + (message "Using tag file...") + (slime-goto-definition name tagdefs)) + (t + (error "No known definition for: %s" name))))) + +(defun slime-etags-definitions (name) + "Search definitions matching NAME in the tags file. +The result is a (possibly empty) list of definitions." + (let ((defs '())) + (save-excursion + (let ((first-time t)) + (while (visit-tags-table-buffer (not first-time)) + (setq first-time nil) + (goto-char (point-min)) + (while (search-forward name nil t) + (beginning-of-line) + (destructuring-bind (hint line &rest pos) (etags-snarf-tag) + (unless (eq hint t) ; hint==t if we are in a filename line + (let ((file (expand-file-name (file-of-tag)))) + (let ((loc `(:location (:file ,file) + (:line ,line) + (:snippet ,hint)))) + (push (list hint loc) defs)))))))) + (reverse defs)))) + (defun slime-show-definitions (name definitions) (slime-show-xrefs `((,name . ,(loop for (dspec location) in definitions @@ -5304,165 +5343,175 @@ (insert "\n") (slime-eval-print string)) -;;This is an extension for the trace command. -;;Several interesting cases (the . shows the point position): + +;;;; Tracing + +(defun slime-untrace-all () + "Untrace all functions." + (interactive) + (slime-eval `(swank:untrace-all))) -;; (defun n.ame (...) ...) -> (:defun name) -;; (defun (setf n.ame) (...) ...) -> (:defun (setf name)) -;; (defmethod n.ame (...) ...) -> (:defmethod name (...)) -;; (defun ... (...) (labels ((n.ame (...) -> (:labels (:defun ...) name) -;; (defun ... (...) (flet ((n.ame (...) -> (:flet (:defun ...) name) -;; (defun ... (...) ... (n.ame ...) ...) -> (:call (:defun ...) name) -;; (defun ... (...) ... (setf (n.ame ...) -> (:call (:defun ...) (setf name)) - -;; All other context should be identified as normal, traditional, -;; function calls. - -(defun complete-name-context-at-point () - "Return the name of the function at point, otherwise nil. This -tries to be clever to understand a bit of the context." - (let ((name (thing-at-point 'symbol))) - (and name - (or (ignore-errors - (save-excursion - (name-context-at-point (intern name)))) - (intern name))))) - -(defun name-context-at-point (name) - (out-first 1) - (cond ((looking-at "defun") ;a function definition - `(:defun ,name)) - ((looking-at "defmacro") ;a macro definition - `(:defmacro ,name)) - ((looking-at "defgeneric") ;a defgeneric form, maybe trace all methods - `(:defgeneric ,name)) - ((looking-at "defmethod") ;a defmethod, maybe trace just this method - (forward-sexp 3) ;jump defmethod, name, and possibly, arglist - (let ((qualifier - (if (= (or (char-before) -1) ?\)) ;ok, after arglist - (progn - (forward-sexp -1) - (list)) - (list (read (current-buffer))))) ;it was a qualifier - (arglist (read (current-buffer)))) - `(:defmethod ,name , at qualifier ,(parameter-specializers arglist)))) - ((looking-at "setf ") ;looks like a setf-definition, but which? - (up-list -1) - (name-context-at-point `(setf ,name))) - ((and (symbolp name) - (looking-at (symbol-name name))) ;the name itself, we - ;need further - ;investigation - (out-first 2) - (cond ((looking-at "setf ") ;a setf-call - (let ((def (ignore-errors (definition-name)))) - (if def - `(:call ,def (setf ,name)) - `(setf ,name)))) - ((ignore-errors - (save-excursion - (out-first 2) - (cond ((or (looking-at "labels") (looking-at "flet")) - (let ((fdef (definition-name))) - (if (looking-at "labels") - `(:labels ,fdef ,name) - `(:flet ,fdef ,name)))) - (t `(:call ,(definition-name) ,name)))))) - (t `(:call ,(definition-name) ,name)))) - (t - name))) - -(defun out-first (n) - (up-list (- n)) - (forward-char 1) +(defun slime-toggle-trace-fdefinition (&optional using-context-p) + "Toggle trace." + (interactive "P") + (let ((spec (if using-context-p + (slime-extract-context) + (slime-symbol-at-point)))) + (cond ((not spec) + (error "No symbol to trace")) + (t + (let ((spec (slime-trace-query spec))) + (message "%s" (slime-eval `(swank:swank-toggle-trace ,spec)))))))) + +(defun slime-trace-query (spec) + "Ask the user which function to query; SPEC is the default. +The result is a string." + (cond ((symbolp spec) + (slime-read-from-minibuffer "(Un)trace: " (symbol-name spec))) + (t + (destructure-case spec + ((:setf n) + (slime-read-from-minibuffer "(Un)trace: " (prin1-to-string spec))) + (((:defun :defmacro) n) + (slime-read-from-minibuffer "(Un)trace: " (prin1-to-string n))) + ((:defgeneric n) + (let* ((name (prin1-to-string n)) + (answer (slime-read-from-minibuffer "(Un)trace: " name))) + (cond ((and (string= name answer) + (y-or-n-p (concat "(Un)trace also all " + "methods implementing " + name "? "))) + (prin1-to-string `(:defgeneric ,name))) + (t + answer)))) + ((:defmethod &rest _) + (slime-read-from-minibuffer "(Un)trace: " (prin1-to-string spec))) + ((:call caller callee) + (let* ((callerstr (prin1-to-string caller)) + (calleestr (prin1-to-string callee)) + (answer (slime-read-from-minibuffer "(Un)trace: " + calleestr))) + (cond ((and (string= calleestr answer) + (y-or-n-p (concat "(Un)trace only when " calleestr + " is called by " callerstr "? "))) + (prin1-to-string `(:call ,caller ,callee))) + (t + answer)))) + (((:labels :flet) &rest _) + (slime-read-from-minibuffer "(Un)trace local function: " + (prin1-to-string spec))))))) + +(defun slime-extract-context () + "Parse the context for the symbol at point. +Nil is returned if there's no symbol at point. Otherwise we detect +the following cases (the . shows the point position): + + (defun n.ame (...) ...) -> (:defun name) + (defun (setf n.ame) (...) ...) -> (:defun (setf name)) + (defmethod n.ame (...) ...) -> (:defmethod name (...)) + (defun ... (...) (labels ((n.ame (...) -> (:labels (:defun ...) name) + (defun ... (...) (flet ((n.ame (...) -> (:flet (:defun ...) name) + (defun ... (...) ... (n.ame ...) ...) -> (:call (:defun ...) name) + (defun ... (...) ... (setf (n.ame ...) -> (:call (:defun ...) (setf name)) + +For other contexts we return the symbol at point." + (let ((name (slime-symbol-name-at-point))) + (if name + (let ((symbol (read name))) + (or (progn ;;ignore-errors + (slime-parse-context symbol)) + symbol))))) + +(defun slime-parse-context (name) + (save-excursion + (cond ((slime-in-expression-p '(defun *)) `(:defun ,name)) + ((slime-in-expression-p '(defmacro *)) `(:defmacro ,name)) + ((slime-in-expression-p '(defgeneric *)) `(:defgeneric ,name)) + ((slime-in-expression-p '(setf *)) + ;;a setf-definition, but which? + (backward-up-list 1) + (slime-parse-context `(setf ,name))) + ((slime-in-expression-p '(defmethod *)) + (forward-sexp 1) + (let (qualifiers arglist) + (loop for e = (read (current-buffer)) + until (listp e) do (push e qualifiers) + finally (setq arglist e)) + `(:defmethod ,name , at qualifiers + ,(slime-arglist-specializers arglist)))) + ((and (symbolp name) + (slime-in-expression-p `(,name))) + ;; looks like a regular call + (let ((toplevel (ignore-errors (slime-parse-toplevel-form)))) + (cond ((slime-in-expression-p `(setf *)) ;a setf-call + (if toplevel + `(:call ,toplevel (setf ,name)) + `(setf ,name))) + ((not toplevel) + name) + ((slime-in-expression-p `(labels ((*)))) + `(:labels ,toplevel ,name)) + ((slime-in-expression-p `(flet ((*)))) + `(:flet ,toplevel ,name)) + (t + `(:call ,toplevel ,name))))) + (t + name)))) + +(defun slime-in-expression-p (pattern) + "A helper function to determine the current context. +The pattern can have the form: + pattern ::= () ;matches always + | (*) ;matches insde a list + | ( ) ;matches if the first element in + ; current the list is and + ; if matches. + | (()) ;matches if are in a nested list." + (save-excursion + (let ((path (reverse (slime-pattern-path pattern)))) + (loop for p in path + always (ignore-errors + (etypecase p + (symbol (slime-beginning-of-list) + (looking-at (symbol-name p))) + (number (backward-up-list p) + t))))))) + +(defun slime-pattern-path (pattern) + ;; Compute the path to the * in the pattern to make matching + ;; easier. The path is a list of symbols and numbers. A number + ;; means "(down-list )" and a symbol "(look-at )") + (if (null pattern) + '() + (etypecase (car pattern) + ((member *) '()) + (symbol (cons (car pattern) (slime-pattern-path (cdr pattern)))) + (cons (cons 1 (slime-pattern-path (car pattern))))))) + +(defun slime-beginning-of-list (&optional up) + "Move backward the the beginning of the current expression. +Point is placed before the first expression in the list." + (backward-up-list (or up 1)) + (down-list 1) (skip-syntax-forward " ")) -(defun definition-name () +(defun slime-parse-toplevel-form () (save-excursion (beginning-of-defun) - (forward-char 1) + (down-list 1) (forward-sexp 1) - (name-context-at-point (read (current-buffer))))) + (slime-parse-context (read (current-buffer))))) -(defun parameter-specializers (arglist) +(defun slime-arglist-specializers (arglist) (cond ((or (null arglist) (member (first arglist) '(&optional &key &rest &aux))) (list)) ((consp (first arglist)) (cons (second (first arglist)) - (parameter-specializers (rest arglist)))) + (slime-arglist-specializers (rest arglist)))) (t (cons 't - (parameter-specializers (rest arglist)))))) - - -;;Now, we need to present the options for the user to choose - -(defun slime-toggle-trace-fdefinition () - "Toggle trace." - (interactive) - (let ((spec (complete-name-context-at-point))) - (cond ((symbolp spec) ;;trivial case - (slime-toggle-trace-function spec)) - (t - (ecase (first spec) - ((setf) - (slime-toggle-trace-function spec)) - ((:defun :defmacro) - (slime-toggle-trace-function (second spec))) - (:defgeneric - (slime-toggle-trace-defgeneric (second spec))) - (:defmethod - (slime-toggle-trace-defmethod spec)) - (:call - (slime-toggle-trace-maybe-wherein (third spec) (second spec))) - ((:labels :flet) - (slime-toggle-trace-within spec))))))) - -(defun slime-toggle-trace-function (name) - (let ((real-name (slime-read-from-minibuffer "(Un)trace: " - (prin1-to-string name)))) - (message "%s" (slime-eval `(swank:toggle-trace-function - (swank::from-string ,real-name)))))) - -(defun slime-toggle-trace-defgeneric (name) - (let ((name (prin1-to-string name))) - (let ((real-name (slime-read-from-minibuffer "(Un)trace: " name))) - (if (and (string= name real-name) - (y-or-n-p (format "(Un)trace also all methods implementing %s " - real-name))) - (message "%s" (slime-eval `(swank:toggle-trace-generic-function-methods - (swank::from-string ,real-name)))) - (message "%s" (slime-eval `(swank:toggle-trace-function (swank::from-string ,real-name)))))))) - -(defun slime-toggle-trace-defmethod (spec) - (let ((real-name (slime-read-from-minibuffer "(Un)trace: " - (prin1-to-string spec)))) - (message "%s" (slime-eval `(swank:toggle-trace-method - (swank::from-string ,real-name)))))) - -(defun slime-toggle-trace-maybe-wherein (name wherein) - (let ((real-name (slime-read-from-minibuffer "(Un)trace: " - (prin1-to-string name))) - (wherein (prin1-to-string wherein))) - (if (and (string= name real-name) - (y-or-n-p (format "(Un)trace only when %s call is made from %s " - real-name wherein))) - (message "%s" (slime-eval `(swank:toggle-trace-fdefinition-wherein - (swank::from-string ,real-name) - (swank::from-string ,wherein)))) - (message "%s" (slime-eval `(swank:toggle-trace-fdefinition ,real-name)))))) - -(defun slime-toggle-trace-within (spec) - (let ((real-name (slime-read-from-minibuffer "(Un)trace local function: " - (prin1-to-string spec)))) - (message "%s" (slime-eval `(swank:toggle-trace-fdefinition-within - (swank::from-string ,real-name)))))) - -(defun slime-untrace-all () - "Untrace all functions." - (interactive) - (slime-eval `(swank:untrace-all))) + (slime-arglist-specializers (rest arglist)))))) (defun slime-disassemble-symbol (symbol-name) "Display the disassembly for SYMBOL-NAME." @@ -5795,6 +5844,11 @@ "Show all known callers of the function SYMBOL." (interactive (list (slime-read-symbol-name "Who calls: " t))) (slime-xref :calls symbol)) + +(defun slime-calls-who (symbol) + "Show all known functions called by the function SYMBOL." + (interactive (list (slime-read-symbol-name "Who calls: " t))) + (slime-xref :calls-who symbol)) (defun slime-who-references (symbol) "Show all known referrers of the global variable SYMBOL." From heller at common-lisp.net Mon Feb 28 23:31:06 2005 From: heller at common-lisp.net (Helmut Eller) Date: Tue, 1 Mar 2005 00:31:06 +0100 (CET) Subject: [slime-cvs] CVS update: slime/swank-backend.lisp Message-ID: <20050228233106.B49B3884E2@common-lisp.net> Update of /project/slime/cvsroot/slime In directory common-lisp.net:/tmp/cvs-serv6624 Modified Files: swank-backend.lisp Log Message: (calls-who, toggle-trace): New functions. (toggle-trace-function, toggle-trace-generic-function-methods, (toggle-trace-method, toggle-trace-fdefinition-wherein): Replaced by toggle-trace. Date: Tue Mar 1 00:30:59 2005 Author: heller Index: slime/swank-backend.lisp diff -u slime/swank-backend.lisp:1.80 slime/swank-backend.lisp:1.81 --- slime/swank-backend.lisp:1.80 Thu Feb 24 19:09:33 2005 +++ slime/swank-backend.lisp Tue Mar 1 00:30:59 2005 @@ -569,6 +569,10 @@ "Return the call sites of FUNCTION-NAME (a symbol). The results is a list ((DSPEC LOCATION) ...).") +(definterface calls-who (function-name) + "Return the call sites of FUNCTION-NAME (a symbol). +The results is a list ((DSPEC LOCATION) ...).") + (definterface who-references (variable-name) "Return the locations where VARIABLE-NAME (a symbol) is referenced. See WHO-CALLS for a description of the return value.") @@ -791,30 +795,12 @@ "Return the next message from current thread's mailbox." nil) -(definterface toggle-trace-function (spec) - "Trace one function, including (setf name) forms." - (cond ((symbolp spec) - (eval `(trace ,spec))) - (t - (format nil "Cannot trace fspec: ~S" spec)))) - -(definterface toggle-trace-generic-function-methods (name) - "Trace the generic function and all methods of the generic function." - (declare (ignore name)) - "Sorry, generic function tracing has to yet been implemented on your platform.") - -(definterface toggle-trace-method (spec) - "Trace one method. -SPEC is if the form (:defmethod ,NAME , at QUALIFIERS (, at SPECIALIZERS))." - (declare (ignore spec)) - "Sorry, method tracing has not yet been implemented on your platform.") - -(definterface toggle-trace-fdefinition-wherein (name wherein) - "Trace function when called by another function." - (declare (ignore name wherein)) - "Sorry, call-path tracing has not yet been implemented on your platform.") - -(definterface toggle-trace-fdefinition-within (spec) - "Trace local function within other function." - (declare (ignore spec)) - "Sorry, local function tracing has not yet been implemented on your platform.") \ No newline at end of file +(definterface toggle-trace (spec) + "Toggle tracing of the function(s) given with SPEC. +SPEC can be: + (setf NAME) ; a setf function + (:defmethod NAME QUALIFIER... (SPECIALIZER...)) ; a specific method + (:defgeneric NAME) ; a generic function with all methods + (:call CALLER CALLEE) ; trace calls from CALLER to CALLEE. + (:labels TOPLEVEL LOCAL) + (:flet TOPLEVEL LOCAL) ") From heller at common-lisp.net Mon Feb 28 23:32:09 2005 From: heller at common-lisp.net (Helmut Eller) Date: Tue, 1 Mar 2005 00:32:09 +0100 (CET) Subject: [slime-cvs] CVS update: slime/swank-cmucl.lisp slime/swank-sbcl.lisp slime/swank-lispworks.lisp slime/swank-allegro.lisp Message-ID: <20050228233209.6593D884E2@common-lisp.net> Update of /project/slime/cvsroot/slime In directory common-lisp.net:/tmp/cvs-serv6997 Modified Files: swank-cmucl.lisp swank-sbcl.lisp swank-lispworks.lisp swank-allegro.lisp Log Message: (toggle-trace): Update tracing code for new interface. Date: Tue Mar 1 00:32:06 2005 Author: heller Index: slime/swank-cmucl.lisp diff -u slime/swank-cmucl.lisp:1.139 slime/swank-cmucl.lisp:1.140 --- slime/swank-cmucl.lisp:1.139 Sat Feb 26 11:39:22 2005 +++ slime/swank-cmucl.lisp Tue Mar 1 00:32:06 2005 @@ -898,7 +898,8 @@ (let ((macro? (and (symbolp name) (macro-function name))) (special? (and (symbolp name) (special-operator-p name))) (function? (and (ext:valid-function-name-p name) - (ext:info :function :definition name)))) + (ext:info :function :definition name) + (if (symbolp name) (fboundp name) t)))) (cond (macro? (list `((defmacro ,name) ,(function-location (macro-function name))))) @@ -1329,6 +1330,9 @@ (symbol-function name)))) (defimplementation arglist ((fun function)) + (function-arglist fun)) + +(defun function-arglist (fun) (let ((arglist (cond ((eval:interpreted-function-p fun) (eval:interpreted-function-arglist fun)) @@ -1750,6 +1754,9 @@ (let ((values (breakpoint-values breakpoint))) (brk values "Return value: ~{~S ~}" values))) (t + #+(or) + (when (eq (di:code-location-kind what) :call-site) + (call-site-function breakpoint frame)) (brk nil "Breakpoint: ~S ~S" (di:code-location-kind what) (di::compiled-code-location-pc what))))) @@ -2181,44 +2188,44 @@ ;; (trace :methods t ') ;;to trace all methods of the gf ;; can be a normal name or a (setf name) -(defun toggle-trace (fspec &rest args) - (cond ((member fspec (eval '(trace)) :test #'equal) - (eval `(untrace ,fspec)) - (format nil "~S is now untraced." fspec)) - (t - (eval `(trace ,fspec , at args)) - (format nil "~S is now traced." fspec)))) +(defun tracedp (spec) + (member spec (eval '(trace)) :test #'equal)) -(defimplementation toggle-trace-generic-function-methods (name) - (cond ((member name (eval '(trace)) :test #'equal) - (eval `(untrace ,name)) - (eval `(untrace :methods ',name)) - (format nil "~S is now untraced." name)) +(defun toggle-trace-aux (spec &rest options) + (cond ((tracedp spec) + (eval `(untrace ,spec)) + (format nil "~S is now untraced." spec)) (t - (eval `(trace ,name)) - (eval `(trace :methods ',name)) - (format nil "~S is now traced." name)))) + (eval `(trace ,spec , at options)) + (format nil "~S is now traced." spec)))) + +(defimplementation toggle-trace (spec) + (ecase (car spec) + ((setf) + (toggle-trace-aux spec)) + ((:defgeneric) + (let ((name (second spec))) + (toggle-trace-aux name :methods name))) + ((:defmethod) + (toggle-trace-aux `(method ,(cdr spec))) + ;; Man, is this ugly + (toggle-trace-aux `(pcl::fast-method ,(cdr spec)))) + ((:call) + (destructuring-bind (caller callee) (cdr spec) + (toggle-trace-aux (process-fspec callee) + :wherein (list (process-fspec caller))))))) (defun process-fspec (fspec) (cond ((consp fspec) (ecase (first fspec) ((:defun :defgeneric) (second fspec)) - ((:defmethod) `(method ,@(rest fspec))) + ((:defmethod) + `(method ,(second fspec) ,@(third fspec) ,(fourth fspec))) + ;; this isn't actually supported ((:labels) `(labels ,(process-fspec (second fspec)) ,(third fspec))) ((:flet) `(flet ,(process-fspec (second fspec)) ,(third fspec))))) (t fspec))) - -(defimplementation toggle-trace-function (spec) - (toggle-trace spec)) - -#+cmu19 -(defimplementation toggle-trace-method (spec) - (toggle-trace `(pcl:fast-method ,@(rest (process-fspec spec))))) - -#+cmu19 -(defimplementation toggle-trace-fdefinition-wherein (name wherein) - (toggle-trace name :wherein (process-fspec wherein))) ;; Local Variables: ;; pbook-heading-regexp: "^;;;\\(;+\\)" Index: slime/swank-sbcl.lisp diff -u slime/swank-sbcl.lisp:1.118 slime/swank-sbcl.lisp:1.119 --- slime/swank-sbcl.lisp:1.118 Thu Feb 24 19:10:02 2005 +++ slime/swank-sbcl.lisp Tue Mar 1 00:32:06 2005 @@ -944,7 +944,7 @@ ;; (trace (method ? (+))) ;; can be a normal name or a (setf name) -(defun toggle-trace (fspec &rest args) +(defun toggle-trace-aux (fspec &rest args) (cond ((member fspec (eval '(trace)) :test #'equal) (eval `(untrace ,fspec)) (format nil "~S is now untraced." fspec)) @@ -952,9 +952,6 @@ (eval `(trace ,@(if args `(:encapsulate nil) (list)) ,fspec , at args)) (format nil "~S is now traced." fspec)))) -(defimplementation toggle-trace-generic-function-methods (name) - (toggle-trace name :methods t)) - (defun process-fspec (fspec) (cond ((consp fspec) (ecase (first fspec) @@ -965,11 +962,14 @@ (t fspec))) -(defimplementation toggle-trace-function (spec) - (toggle-trace spec)) - -(defimplementation toggle-trace-method (spec) - (toggle-trace `(sb-pcl::fast-method ,@(rest (process-fspec spec))))) - -(defimplementation toggle-trace-fdefinition-wherein (name wherein) - (toggle-trace name :wherein (process-fspec wherein))) +(defimplementation toggle-trace (spec) + (ecase (car spec) + ((setf) + (toggle-trace-aux spec)) + ((:defmethod) + (toggle-trace-aux `(sb-pcl::fast-method ,@(rest (process-fspec spec))))) + ((:defgeneric) + (toggle-trace-aux (second spec) :methods t)) + ((:call) + (destructuring-bind (caller callee) (cdr spec) + (toggle-trace-aux callee :wherein (list (process-fspec caller))))))) Index: slime/swank-lispworks.lisp diff -u slime/swank-lispworks.lisp:1.66 slime/swank-lispworks.lisp:1.67 --- slime/swank-lispworks.lisp:1.66 Thu Feb 24 19:08:59 2005 +++ slime/swank-lispworks.lisp Tue Mar 1 00:32:06 2005 @@ -533,8 +533,9 @@ (defxref who-calls hcl:who-calls) (defxref who-macroexpands hcl:who-calls) ; macros are in the calls table too -(defxref list-callees hcl:calls-who) +(defxref calls-who hcl:calls-who) (defxref list-callers list-callers-internal) +(defxref list-callees list-callees-internal) (defun list-callers-internal (name) (let ((callers (make-array 100 @@ -608,12 +609,12 @@ (defun parse-fspec (fspec) "Return a dspec for FSPEC." (ecase (car fspec) - (:defmethod `(method ,@(cdr fspec))))) + ((:defmethod) `(method ,(cdr fspec))))) (defun tracedp (dspec) (member dspec (eval '(trace)) :test #'equal)) -(defun toggle-trace (dspec) +(defun toggle-trace-aux (dspec) (cond ((tracedp dspec) (eval `(untrace ,dspec)) (format nil "~S is now untraced." dspec)) @@ -621,8 +622,8 @@ (eval `(trace (,dspec))) (format nil "~S is now traced." dspec)))) -(defimplementation toggle-trace-method (fspec) - (toggle-trace (parse-fspec fspec))) +(defimplementation toggle-trace (fspec) + (toggle-trace-aux (parse-fspec fspec))) ;;; Multithreading Index: slime/swank-allegro.lisp diff -u slime/swank-allegro.lisp:1.69 slime/swank-allegro.lisp:1.70 --- slime/swank-allegro.lisp:1.69 Tue Feb 22 07:27:17 2005 +++ slime/swank-allegro.lisp Tue Mar 1 00:32:06 2005 @@ -271,7 +271,8 @@ (defimplementation call-with-compilation-hooks (function) (handler-bind ((warning #'handle-compiler-warning) - (compiler-note #'handle-compiler-warning)) + ;;(compiler-note #'handle-compiler-warning) + ) (funcall function))) (defimplementation swank-compile-file (*compile-filename* load-p) @@ -402,11 +403,11 @@ (xref-result (xref:get-relation ,relation ,name1 ,name2)))) (defxref who-calls :calls :wild x) +(defxref calls-who :calls x :wild) (defxref who-references :uses :wild x) (defxref who-binds :binds :wild x) (defxref who-macroexpands :macro-calls :wild x) (defxref who-sets :sets :wild x) -(defxref list-callees :calls x :wild) (defun xref-result (fspecs) (loop for fspec in fspecs @@ -436,7 +437,7 @@ (when (eq c symbol) (return-from in-constants-p t))) 3)) - + (defun function-callers (name) (let ((callers '())) (do-all-symbols (sym) @@ -449,6 +450,15 @@ (defimplementation list-callers (name) (xref-result (function-callers name))) +(defimplementation list-callees (name) + (let ((result '())) + (map-function-constants (fdefinition name) + (lambda (c) + (when (fboundp c) + (push c result))) + 2) + (xref-result result))) + ;;;; Inspecting (defclass acl-inspector (inspector) @@ -674,27 +684,39 @@ ;; (trace ((labels (method (+)) ))) ;; can be a normal name or a (setf name) +(defimplementation toggle-trace (spec) + (ecase (car spec) + (:defgeneric (toggle-trace-generic-function-methods (second spec))) + ((:defmethod :labels :flet) + (toggle-trace-aux (process-fspec-for-allegro spec))) + (:call + (destructuring-bind (caller callee) (cdr spec) + (toggle-trace-aux callee + :inside (list (process-fspec-for-allegro caller))))))) + +(defun tracedp (fspec) + (member name (eval '(trace)) :test #'equal)) + +(defun toggle-trace-aux (fspec &rest args) + (cond ((tracedp fspec) + (eval `(untrace ,fspec)) + (format nil "~S is now untraced." fspec)) + (t + (eval `(trace (,fspec , at args))) + (format nil "~S is now traced." fspec)))) + #-allegro-v5.0 -(defimplementation toggle-trace-generic-function-methods (name) +(defun toggle-trace-generic-function-methods (name) (let ((methods (mop:generic-function-methods (fdefinition name)))) - (cond ((member name (eval '(trace)) :test #'equal) + (cond ((tracedp name) (eval `(untrace ,name)) (dolist (method methods (format nil "~S is now untraced." name)) (excl:funtrace (mop:method-function method)))) (t (eval `(trace ,name)) - (dolist (method methods - (format nil "~S is now traced." name)) + (dolist (method methods (format nil "~S is now traced." name)) (excl:ftrace (mop:method-function method))))))) -(defun toggle-trace (fspec &rest args) - (cond ((member fspec (eval '(trace)) :test #'equal) - (eval `(untrace ,fspec)) - (format nil "~S is now untraced." fspec)) - (t - (eval `(trace (,fspec , at args))) - (format nil "~S is now traced." fspec)))) - (defun process-fspec-for-allegro (fspec) (cond ((consp fspec) (ecase (first fspec) @@ -706,18 +728,3 @@ ,(third fspec))))) (t fspec))) - -(defimplementation toggle-trace-function (spec) - (toggle-trace spec)) - -(defimplementation toggle-trace-method (spec) - (toggle-trace (process-fspec-for-allegro spec))) - -(defimplementation toggle-trace-fdefinition-wherein (name wherein) - (toggle-trace name :inside (if (and (consp wherein) - (eq (first wherein) :defmethod)) - (list (process-fspec-for-allegro wherein)) - (process-fspec-for-allegro wherein)))) - -(defimplementation toggle-trace-fdefinition-within (spec) - (toggle-trace (process-fspec-for-allegro spec))) From heller at common-lisp.net Mon Feb 28 23:32:59 2005 From: heller at common-lisp.net (Helmut Eller) Date: Tue, 1 Mar 2005 00:32:59 +0100 (CET) Subject: [slime-cvs] CVS update: slime/swank.lisp Message-ID: <20050228233259.C63E0884E2@common-lisp.net> Update of /project/slime/cvsroot/slime In directory common-lisp.net:/tmp/cvs-serv7255 Modified Files: swank.lisp Log Message: (*sldb-printer-bindings*, *swank-pprint-bindings*): New variables. The alists replace the variables which where previously hidden with the define-printer-variables macro. (define-printer-variables, with-printer-settings): Deleted, because the variable names where not visible in the source code. (swank-toggle-trace): Renamed from toggle-trace-fdefinition. Date: Tue Mar 1 00:32:58 2005 Author: heller Index: slime/swank.lisp diff -u slime/swank.lisp:1.281 slime/swank.lisp:1.282 --- slime/swank.lisp:1.281 Thu Feb 24 19:08:24 2005 +++ slime/swank.lisp Tue Mar 1 00:32:58 2005 @@ -29,12 +29,8 @@ #:*readtable-alist* #:*globally-redirect-io* #:*global-debugger* - #:*sldb-print-pretty* - #:*sldb-print-circle* - #:*sldb-print-length* - #:*sldb-print-level* - #:*sldb-print-lines* - #:*sldb-print-pprint-dispatch* + #:*sldb-printer-bindings* + #:*swank-pprint-bindings* #:*default-worker-thread-bindings* ;; These are re-exported directly from the backend: #:buffer-first-change @@ -50,13 +46,7 @@ #:profile-package #:default-directory #:set-default-directory - #:quit-lisp - #:toggle-trace-function - #:toggle-trace-generic-function-methods - #:toggle-trace-method - #:toggle-trace-fdefinition-wherein - #:toggle-trace-fdefinition-within -)) + #:quit-lisp)) (in-package :swank) @@ -86,6 +76,44 @@ (defvar *swank-debug-p* t "When true, print extra debugging information.") +(defvar *sldb-printer-bindings* + `((*print-pretty* . nil) + (*print-level* . 4) + (*print-length* . 10) + (*print-circle* . t) + (*print-readably* . nil) + (*print-pprint-dispatch* . ,(copy-pprint-dispatch nil)) + (*print-gensym* . t) + (*print-base* . 10) + (*print-radix* . nil) + (*print-array* . t) + (*print-lines* . 200) + (*print-escape* . t)) + "A set of printer variables used in the debugger.") + +(defvar *swank-pprint-bindings* + `((*print-level* . nil) + (*print-length* . nil) + (*print-circle* . t) + (*print-gensym* . t) + (*print-readably* . nil) + (*print-pprint-dispatch* . ,(copy-pprint-dispatch nil))) + "A list of variables bindings during pretty printing. +Used when printing macroexpansions and pprint-eval.") + +(defvar *default-worker-thread-bindings* '() + "An alist to initialize dynamic variables in worker threads. +The list has the form ((VAR . VALUE) ...). Each variable VAR will be +bound to the corresponding VALUE.") + +(defun call-with-bindings (alist fun) + "Call FUN with variables bound according to ALIST. +ALIST is a list of the form ((VAR . VAL) ...)." + (let ((vars (mapcar #'car alist)) + (vals (mapcar #'cdr alist))) + (progv vars vals + (funcall fun)))) + ;;; The `DEFSLIMEFUN' macro defines a function that Emacs can call via ;;; RPC. @@ -453,11 +481,6 @@ ;;;;;; Thread based communication -(defvar *default-worker-thread-bindings* '() - "An alist to initialize dynamic variables in worker threads. -The list has the form ((VAR . VALUE) ...). Each variable VAR will be -bound to the corresponding VALUE.") - (defvar *active-threads* '()) (defun read-loop (control-thread input-stream connection) @@ -511,12 +534,6 @@ (handle-request connection)))) :name "worker")) -(defun call-with-bindings (alist fn) - (let ((vars (mapcar #'car alist)) - (vals (mapcar #'cdr alist))) - (progv vars vals - (funcall fn)))) - (defun dispatch-event (event socket-io) "Handle an event triggered either by Emacs or within Lisp." (log-event "DISPATCHING: ~S~%" event) @@ -1590,60 +1607,18 @@ (makunbound name) (prin1-to-string (eval form)))))) -(defmacro define-printer-variables (prefix &body vars) - "Define a group of printer variables. - -The elements of VARS can have the form: NAME or (NAME INIT). NAME -must be one of the symbols (pretty circle case escape right-margin -level length). PREFIX and NAME are concatenated, like *PREFIX-NAME*, -to form the names of the actual variable. The new variable is -initialized with INIT or, if INIT was not specified, with the value of -the corresponding printer variable. - -At macroexpansion time the names of the created symbols are stored in -the 'printer-variables property of PREFIX." - (let ((valid-names '(level length circle readably pretty - case escape right-margin miser-width - base radix gensym array lines pprint-dispatch))) - (labels ((symconc (prefix suffix) - (intern (format nil "*~A-~A*" (string prefix) (string suffix)) - :swank)) - (parse (var) - (destructuring-bind (name init &optional doc) - (if (consp var) var (list var (symconc 'print var))) - (unless (member name valid-names) - (error "Not a printer variable: ~S" var)) - (list name init doc)))) - (let* ((bindings (mapcar #'parse vars))) - (setf (get prefix 'printer-variables) - (loop for (name) in bindings - collect `(,(symconc 'print name) ,(symconc prefix name)))) - `(progn - ,@(loop for (name init doc) in bindings - collect `(defvar ,(symconc prefix name) ,init - ,@(if doc (list doc))))))))) - - -(define-printer-variables swank-pprint - circle level length case right-margin escape) - -(defmacro with-printer-settings (group &body body) - "Rebind the pringer variables in GROUP and execute body. -See `define-printer-variables'." - (let ((bindings (get group 'printer-variables))) - (when (not bindings) (warn "No printer variables for: ~S" group)) - `(let ,bindings , at body))) - (defun swank-pprint (list) "Bind some printer variables and pretty print each object in LIST." (with-buffer-syntax () - (with-printer-settings swank-pprint - (let ((*print-pretty* t)) - (cond ((null list) "; No value") - (t (with-output-to-string (*standard-output*) - (dolist (o list) - (pprint o) - (terpri))))))))) + (call-with-bindings + *swank-pprint-bindings* + (lambda () + (let ((*print-pretty* t)) + (cond ((null list) "; No value") + (t (with-output-to-string (*standard-output*) + (dolist (o list) + (pprint o) + (terpri)))))))))) (defslimefun pprint-eval (string) (with-buffer-syntax () @@ -1726,16 +1701,6 @@ (defvar *sldb-stepping-p* nil "True when during execution of a stepp command.") -;; A set of printer variables used in the debugger. -(define-printer-variables sldb-print - (pretty nil) - (level 4) - (length 10) - (circle t) - (readably nil) - (pprint-dispatch (copy-pprint-dispatch nil)) - gensym base radix array lines) - (defun debug-in-emacs (condition) (let ((*swank-debugger-condition* condition) (*sldb-restarts* (compute-restarts condition)) @@ -1746,9 +1711,11 @@ (*sldb-stepping-p* nil) (*swank-state-stack* (cons :swank-debugger-hook *swank-state-stack*))) (force-user-output) - (with-printer-settings sldb-print - (call-with-debugging-environment - (lambda () (sldb-loop *sldb-level*)))))) + (call-with-bindings + *sldb-printer-bindings* + (lambda () + (call-with-debugging-environment + (lambda () (sldb-loop *sldb-level*))))))) (defun sldb-loop (level) (unwind-protect @@ -2802,14 +2769,16 @@ (defun tracedp (fspec) (member fspec (eval '(trace)))) -(defslimefun toggle-trace-fdefinition (fname-string) - (let ((fname (from-string fname-string))) - (cond ((tracedp fname) - (eval `(untrace ,fname)) - (format nil "~S is now untraced." fname)) +(defslimefun swank-toggle-trace (spec-string) + (let ((spec (from-string spec-string))) + (cond ((consp spec) ; handle complicated cases in the backend + (toggle-trace spec)) + ((tracedp spec) + (eval `(untrace ,spec)) + (format nil "~S is now untraced." spec)) (t - (eval `(trace ,fname)) - (format nil "~S is now traced." fname))))) + (eval `(trace ,spec)) + (format nil "~S is now traced." spec))))) (defslimefun untrace-all () (untrace)) @@ -2913,6 +2882,7 @@ (group-xrefs (ecase type (:calls (who-calls symbol)) + (:calls-who (calls-who symbol)) (:references (who-references symbol)) (:binds (who-binds symbol)) (:sets (who-sets symbol)) From heller at common-lisp.net Mon Feb 28 23:34:16 2005 From: heller at common-lisp.net (Helmut Eller) Date: Tue, 1 Mar 2005 00:34:16 +0100 (CET) Subject: [slime-cvs] CVS update: slime/ChangeLog Message-ID: <20050228233416.BEC0B88665@common-lisp.net> Update of /project/slime/cvsroot/slime In directory common-lisp.net:/tmp/cvs-serv7346 Modified Files: ChangeLog Log Message: *** empty log message *** Date: Tue Mar 1 00:34:10 2005 Author: heller Index: slime/ChangeLog diff -u slime/ChangeLog:1.616 slime/ChangeLog:1.617 --- slime/ChangeLog:1.616 Thu Feb 24 19:18:10 2005 +++ slime/ChangeLog Tue Mar 1 00:34:08 2005 @@ -1,3 +1,35 @@ +2005-03-01 Helmut Eller + + * slime.el (slime-who-bindings): Bind who-specializes to C-c W a. + (slime-extract-context): Renamed from name-context-at-point. + (slime-beginning-of-list): Renamed from out-first. + (slime-slime-parse-toplevel-form): Renamed from definition-name. + (slime-arglist-specializers): Renamed from parameter-specializers. + (slime-toggle-trace-function, slime-toggle-trace-defgeneric) + (slime-toggle-trace-defmethod, slime-toggle-trace-maybe-wherein) + (slime-toggle-trace-within): Deleted. Everything is now handled + by slime-trace-query. + (slime-calls-who): For symmetry with silme-who-calls. + (slime-edit-definition-with-etags): Better intergration with TAGS. + (slime-edit-definition-fallback-function): Mention it in the + docstring. + + * swank-backend (calls-who, toggle-trace): New functions. + (toggle-trace-function, toggle-trace-generic-function-methods, + (toggle-trace-method, toggle-trace-fdefinition-wherein): Replaced + by toggle-trace. + + * swank.lisp (*sldb-printer-bindings*, *swank-pprint-bindings*): + New variables. The alists replace the variables which where + previously hidden with the define-printer-variables macro. + (define-printer-variables, with-printer-settings): Deleted, + because the variable names where not visible in the source code. + (swank-toggle-trace): Renamed from toggle-trace-fdefinition. + + * swank-cmucl.lisp, swank-lispworks, swank-sbcl.lisp, + swank-allegro.lisp (toggle-trace): Update tracing code for new + interface. + 2005-02-24 Helmut Eller * slime.el (slime-dispatch-event): Add :eval-no-wait and :eval