From trittweiler at common-lisp.net Sun Feb 1 22:50:46 2009 From: trittweiler at common-lisp.net (CVS User trittweiler) Date: Sun, 01 Feb 2009 22:50:46 +0000 Subject: [slime-cvs] CVS slime/contrib Message-ID: Update of /project/slime/cvsroot/slime/contrib In directory cl-net:/tmp/cvs-serv23119/contrib Modified Files: swank-arglists.lisp ChangeLog Log Message: * swank-arglists.lisp (parse-form-spec): Moved most part of its docstring into a comment. (arglist-for-echo-area): Some minor code reorganization. The autodoc stuff in general could need some fair bit of refactoring. --- /project/slime/cvsroot/slime/contrib/swank-arglists.lisp 2008/12/31 16:55:26 1.25 +++ /project/slime/cvsroot/slime/contrib/swank-arglists.lisp 2009/02/01 22:50:46 1.26 @@ -66,46 +66,93 @@ (eq (first form) 'setf) (symbolp (second form))))) +(defmacro with-available-arglist ((var) form &body body) + `(let ((,var ,form)) + (if (eql ,var :not-available) + :not-available + (progn , at body)))) + +;;; A ``raw form spec'' can be either: +;;; +;;; i) a list of strings representing a Common Lisp form +;;; +;;; ii) a list of strings as of i), but which additionally +;;; contains other raw form specs +;;; +;;; iii) one of: +;;; +;;; a) (:declaration declspec) +;;; +;;; where DECLSPEC is a raw form spec. +;;; +;;; b) (:type-specifier typespec) +;;; +;;; where TYPESPEC is a raw form spec. +;;; +;;; +;;; A ``form spec'' is either +;;; +;;; 1) a normal Common Lisp form +;;; +;;; 2) a Common Lisp form with a list as its CAR specifying what namespace +;;; the operator is supposed to be interpreted in: +;;; +;;; a) ((:declaration decl-identifier) declarg1 declarg2 ...) +;;; +;;; b) ((:type-specifier typespec-op) typespec-arg1 typespec-arg2 ...) +;;; +;;; +;;; Examples: +;;; +;;; ("defmethod") => (defmethod) +;;; ("cl:defmethod") => (cl:defmethod) +;;; ("defmethod" "print-object\) => (defmethod print-object) +;;; +;;; ("foo" ("bar" ("quux")) "baz") => (foo (bar (quux)) baz) +;;; +;;; (:declaration ("optimize")) => ((:declaration optimize)) +;;; (:declaration ("type" "string")) => ((:declaration type) string) +;;; (:type-specifier ("float")) => ((:type-specifier float)) +;;; (:type-specifier ("float" 0 100)) => ((:type-specifier float) 0 100) +;;; + (defslimefun arglist-for-echo-area (raw-specs &key arg-indices - print-right-margin print-lines) + print-right-margin print-lines) "Return the arglist for the first valid ``form spec'' in RAW-SPECS. A ``form spec'' is a superset of functions, macros, -special-ops, declarations and type specifiers. - -For more information about the format of ``raw form specs'' and -``form specs'', please see PARSE-FORM-SPEC." +special-ops, declarations and type specifiers." (handler-case (with-buffer-syntax () (multiple-value-bind (form-spec position newly-interned-symbols) (parse-first-valid-form-spec raw-specs #'read-conversatively-for-autodoc) - (unwind-protect - (when form-spec - (let ((arglist (arglist-from-form-spec form-spec :remove-args nil))) - (unless (eql arglist :not-available) - (multiple-value-bind (type operator arguments) - (split-form-spec form-spec) - (declare (ignore arguments)) - (multiple-value-bind (stringified-arglist) - (decoded-arglist-to-string - arglist - :operator operator - :print-right-margin print-right-margin - :print-lines print-lines - :highlight (let ((index (nth position arg-indices))) - ;; don't highlight the operator - (and index (not (zerop index)) index))) - ;; Post formatting: - (case type - (:type-specifier (format nil "[Typespec] ~A" stringified-arglist)) - (:declaration - (locally (declare (special *arglist-pprint-bindings*)) - (with-bindings *arglist-pprint-bindings* - (let ((op (%find-declaration-operator raw-specs position))) - (if op - (format nil "(~A ~A)" op stringified-arglist) - (format nil "[Declaration] ~A" stringified-arglist)))))) - (t stringified-arglist))))))) - (mapc #'unintern-in-home-package newly-interned-symbols)))) + (when form-spec + (unwind-protect + (with-available-arglist (arglist) + (arglist-from-form-spec form-spec :remove-args nil) + (multiple-value-bind (type operator) + (split-form-spec form-spec) + (let* ((index (nth position arg-indices)) + (stringified-arglist + (decoded-arglist-to-string + arglist + :operator operator + :print-right-margin print-right-margin + :print-lines print-lines + ;; Do not highlight the operator: + :highlight (and index (not (zerop index)) index)))) + ;; Post formatting: + (case type + (:type-specifier (format nil "[Typespec] ~A" stringified-arglist)) + (:declaration + (locally (declare (special *arglist-pprint-bindings*)) + (with-bindings *arglist-pprint-bindings* + ;; Try to print ``(declare (declspec))'' (or ``declaim'' etc.) + (let ((op (%find-declaration-operator raw-specs position))) + (if op + (format nil "(~A ~A)" op stringified-arglist) + (format nil "[Declaration] ~A" stringified-arglist)))))) + (t stringified-arglist))))) + (mapc #'unintern-in-home-package newly-interned-symbols))))) (error (cond) (format nil "ARGLIST (error): ~A" cond)) )) @@ -145,51 +192,7 @@ "Takes a raw (i.e. unparsed) form spec from SLIME and returns a proper form spec for further processing within SWANK. Returns NIL if RAW-SPEC could not be parsed. Symbols that had to be interned -in course of the conversion, are returned as secondary return value. - -A ``raw form spec'' can be either: - - i) a list of strings representing a Common Lisp form - - ii) a list of strings as of i), but which additionally - contains other raw form specs - - iii) one of: - - a) (:declaration declspec) - - where DECLSPEC is a raw form spec. - - b) (:type-specifier typespec) - - where TYPESPEC is a raw form spec. - - -A ``form spec'' is either - - 1) a normal Common Lisp form - - 2) a Common Lisp form with a list as its CAR specifying what namespace - the operator is supposed to be interpreted in: - - a) ((:declaration decl-identifier) declarg1 declarg2 ...) - - b) ((:type-specifier typespec-op) typespec-arg1 typespec-arg2 ...) - - -Examples: - - (\"defmethod\") => (defmethod) - (\"cl:defmethod\") => (cl:defmethod) - (\"defmethod\" \"print-object\") => (defmethod print-object) - - (\"foo\" (\"bar\" (\"quux\")) \"baz\" => (foo (bar (quux)) baz) - - (:declaration \"optimize\" \"(optimize)\") => ((:declaration optimize)) - (:declaration \"type\" \"(type string)\") => ((:declaration type) string) - (:type-specifier \"float\" \"(float)\") => ((:type-specifier float)) - (:type-specifier \"float\" \"(float 0 100)\") => ((:type-specifier float) 0 100) -" +in course of the conversion, are returned as secondary return value." (flet ((parse-extended-spec (raw-extension extension-flag) (when (and (stringp (first raw-extension)) ; (:DECLARATION (("a" "b" ("c")) "d")) (nth-value 1 (parse-symbol (first raw-extension)))) @@ -1097,12 +1100,6 @@ (split-form-spec form-spec) (arglist-dispatch type operator arguments :remove-args remove-args)))) -(defmacro with-available-arglist ((var) form &body body) - `(let ((,var ,form)) - (if (eql ,var :not-available) - :not-available - (progn , at body)))) - (defgeneric arglist-dispatch (operator-type operator arguments &key remove-args)) (defmethod arglist-dispatch ((operator-type t) operator arguments &key (remove-args t)) @@ -1147,6 +1144,7 @@ t)))))) (call-next-method)) + (defmethod arglist-dispatch ((operator-type (eql :function)) (operator (eql 'eval-when)) arguments &key (remove-args t)) (let ((eval-when-args '(:compile-toplevel :load-toplevel :execute))) --- /project/slime/cvsroot/slime/contrib/ChangeLog 2009/01/27 15:13:52 1.169 +++ /project/slime/cvsroot/slime/contrib/ChangeLog 2009/02/01 22:50:46 1.170 @@ -1,3 +1,10 @@ +2009-02-01 Tobias C. Rittweiler + + * swank-arglists.lisp (parse-form-spec): Moved most part of its + docstring into a comment. + (arglist-for-echo-area): Some minor code reorganization. The + autodoc stuff in general could need some fair bit of refactoring. + 2009-01-27 Tobias C. Rittweiler * slime-repl.el ([shortcut] quit): Quit the connection before From trittweiler at common-lisp.net Sun Feb 1 23:57:35 2009 From: trittweiler at common-lisp.net (CVS User trittweiler) Date: Sun, 01 Feb 2009 23:57:35 +0000 Subject: [slime-cvs] CVS slime/contrib Message-ID: Update of /project/slime/cvsroot/slime/contrib In directory cl-net:/tmp/cvs-serv2556/contrib Modified Files: swank-arglists.lisp slime-parse.el slime-autodoc.el ChangeLog Log Message: Add DEFMETHOD-style extended arglist display for DEFINE-COMPILER-MACRO. (defun foo (x y &key k1 k2)) (define-compiler-macro foo |) * swank-arglists.lisp ([method] arglist-dispatch): Specialize on (EQL 'DEFINE-COMPILER-MACRO). * slime-parse.el (slime-extended-operator-name-parser-alist): Add entry for DEFINE-COMPILER-MACRO. (slime-make-extended-operator-parser/look-ahead): Collect up /at most/ N sexps. Previously `(defmethod |)' would lead to a form spec of ``("defmethod" ("defmethod"))''. ([test] enclosing-form-specs.1): Test for this. --- /project/slime/cvsroot/slime/contrib/swank-arglists.lisp 2009/02/01 22:50:46 1.26 +++ /project/slime/cvsroot/slime/contrib/swank-arglists.lisp 2009/02/01 23:57:34 1.27 @@ -1144,6 +1144,28 @@ t)))))) (call-next-method)) +;;; FIXME: This was copied & pasted from DEFMETHOD. Refactoring needed! +;;; +(defmethod arglist-dispatch ((operator-type (eql :function)) (operator (eql 'define-compiler-macro)) + arguments &key (remove-args t)) + (format t "ARGUMENTS = ~S~%" arguments) + + (when (and (listp arguments) + (not (null arguments)) ;have function name + (notany #'listp (rest arguments))) ;don't have arglist yet + (let* ((fn-name (first arguments)) + (fn (and (valid-function-name-p fn-name) + (fboundp fn-name) + (fdefinition fn-name)))) + (with-available-arglist (arglist) (arglist fn) + (return-from arglist-dispatch + (values (make-arglist :provided-args (if remove-args + nil + (list fn-name)) + :required-args (list arglist) + :rest "body" :body-p t) + t))))) + (call-next-method)) (defmethod arglist-dispatch ((operator-type (eql :function)) (operator (eql 'eval-when)) arguments &key (remove-args t)) --- /project/slime/cvsroot/slime/contrib/slime-parse.el 2008/12/30 17:12:11 1.13 +++ /project/slime/cvsroot/slime/contrib/slime-parse.el 2009/02/01 23:57:35 1.14 @@ -118,6 +118,7 @@ ("CERROR" . (slime-make-extended-operator-parser/look-ahead 2)) ("CHANGE-CLASS" . (slime-make-extended-operator-parser/look-ahead 2)) ("DEFMETHOD" . (slime-make-extended-operator-parser/look-ahead 1)) + ("DEFINE-COMPILER-MACRO" . (slime-make-extended-operator-parser/look-ahead 1)) ("APPLY" . (slime-make-extended-operator-parser/look-ahead 1)) ("DECLARE" . slime-parse-extended-operator/declare) ("DECLAIM" . slime-parse-extended-operator/declare) @@ -125,18 +126,21 @@ (defun slime-make-extended-operator-parser/look-ahead (steps) "Returns a parser that parses the current operator at point -plus STEPS-many additional sexps on the right side of the -operator." +plus (at most) STEPS-many additional sexps on the right side of +the operator." (lexical-let ((n steps)) #'(lambda (name user-point current-forms current-indices current-points) (let ((old-forms (rest current-forms)) (arg-idx (first current-indices))) - (unless (zerop arg-idx) + (when (and (not (zerop arg-idx)) ; point is at CAR of form? + (not (= (point) ; point is at end of form? + (save-excursion (slime-end-of-list) + (point))))) (let* ((args (slime-ensure-list (slime-parse-sexp-at-point n))) (arg-specs (mapcar #'slime-make-form-spec-from-string args))) - (setq current-forms (cons `(,name , at arg-specs) old-forms))))) - (values current-forms current-indices current-points) - ))) + (setq current-forms (cons `(,name , at arg-specs) old-forms)))) + (values current-forms current-indices current-points) + )))) (defun slime-parse-extended-operator/declare (name user-point current-forms current-indices current-points) @@ -347,5 +351,23 @@ (goto-char string-start-pos) (error "We're not within a string")))) +(def-slime-test enclosing-form-specs.1 + (buffer-sexpr wished-form-specs) + "" + '(("(defmethod *HERE*)" ("defmethod")) + ("(cerror foo *HERE*)" ("cerror" "foo"))) + (slime-check-top-level) + (with-temp-buffer + (let ((tmpbuf (current-buffer))) + (lisp-mode) + (insert buffer-sexpr) + (search-backward "*HERE*") + (multiple-value-bind (specs) + (slime-enclosing-form-specs) + (slime-check "Check enclosing form specs" + (equal specs wished-form-specs))) + ))) + + (provide 'slime-parse) --- /project/slime/cvsroot/slime/contrib/slime-autodoc.el 2009/01/01 15:54:30 1.11 +++ /project/slime/cvsroot/slime/contrib/slime-autodoc.el 2009/02/01 23:57:35 1.12 @@ -233,7 +233,11 @@ (when slime-autodoc-mode (setq ad-return-value (and ad-return-value + ;; Display arglist only when the minibuffer is + ;; inactive, e.g. not on `C-x C-f'. (not (active-minibuffer-window)) + ;; Display arglist only when inferior Lisp will be able + ;; to cope with the request. (slime-background-activities-enabled-p)))) ad-return-value) --- /project/slime/cvsroot/slime/contrib/ChangeLog 2009/02/01 22:50:46 1.170 +++ /project/slime/cvsroot/slime/contrib/ChangeLog 2009/02/01 23:57:35 1.171 @@ -1,5 +1,23 @@ 2009-02-01 Tobias C. Rittweiler + Add DEFMETHOD-style extended arglist display for + DEFINE-COMPILER-MACRO. + + (defun foo (x y &key k1 k2)) + (define-compiler-macro foo |) + + * swank-arglists.lisp ([method] arglist-dispatch): Specialize + on (EQL 'DEFINE-COMPILER-MACRO). + + * slime-parse.el (slime-extended-operator-name-parser-alist): Add + entry for DEFINE-COMPILER-MACRO. + (slime-make-extended-operator-parser/look-ahead): Collect up /at + most/ N sexps. Previously `(defmethod |)' would lead to a form + spec of ``("defmethod" ("defmethod"))''. + ([test] enclosing-form-specs.1): Test for this. + +2009-02-01 Tobias C. Rittweiler + * swank-arglists.lisp (parse-form-spec): Moved most part of its docstring into a comment. (arglist-for-echo-area): Some minor code reorganization. The From trittweiler at common-lisp.net Mon Feb 2 15:29:33 2009 From: trittweiler at common-lisp.net (CVS User trittweiler) Date: Mon, 02 Feb 2009 15:29:33 +0000 Subject: [slime-cvs] CVS slime/contrib Message-ID: Update of /project/slime/cvsroot/slime/contrib In directory cl-net:/tmp/cvs-serv5259 Modified Files: slime-parse.el ChangeLog Log Message: * slime-parse.el ([test] enclosing-form-specs.1): Fix test case. --- /project/slime/cvsroot/slime/contrib/slime-parse.el 2009/02/01 23:57:35 1.14 +++ /project/slime/cvsroot/slime/contrib/slime-parse.el 2009/02/02 15:29:33 1.15 @@ -354,14 +354,15 @@ (def-slime-test enclosing-form-specs.1 (buffer-sexpr wished-form-specs) "" - '(("(defmethod *HERE*)" ("defmethod")) - ("(cerror foo *HERE*)" ("cerror" "foo"))) + '(("(defmethod *HERE*)" (("defmethod"))) + ("(cerror foo *HERE*)" (("cerror" "foo")))) (slime-check-top-level) (with-temp-buffer (let ((tmpbuf (current-buffer))) (lisp-mode) (insert buffer-sexpr) (search-backward "*HERE*") + (delete-region (match-beginning 0) (match-end 0)) (multiple-value-bind (specs) (slime-enclosing-form-specs) (slime-check "Check enclosing form specs" --- /project/slime/cvsroot/slime/contrib/ChangeLog 2009/02/01 23:57:35 1.171 +++ /project/slime/cvsroot/slime/contrib/ChangeLog 2009/02/02 15:29:33 1.172 @@ -1,3 +1,7 @@ +2009-02-02 Tobias C. Rittweiler + + * slime-parse.el ([test] enclosing-form-specs.1): Fix test case. + 2009-02-01 Tobias C. Rittweiler Add DEFMETHOD-style extended arglist display for From trittweiler at common-lisp.net Mon Feb 2 18:55:36 2009 From: trittweiler at common-lisp.net (CVS User trittweiler) Date: Mon, 02 Feb 2009 18:55:36 +0000 Subject: [slime-cvs] CVS slime/contrib Message-ID: Update of /project/slime/cvsroot/slime/contrib In directory cl-net:/tmp/cvs-serv9026 Modified Files: swank-arglists.lisp ChangeLog Log Message: * swank-arglists.lisp (arglist-for-echo-area): Bleh, can't use WITH-AVAILABLE-ARGLIST because we're supposed to return NIL, not :NOT-AVAILABLE, in the failure case. --- /project/slime/cvsroot/slime/contrib/swank-arglists.lisp 2009/02/01 23:57:34 1.27 +++ /project/slime/cvsroot/slime/contrib/swank-arglists.lisp 2009/02/02 18:55:36 1.28 @@ -66,12 +66,6 @@ (eq (first form) 'setf) (symbolp (second form))))) -(defmacro with-available-arglist ((var) form &body body) - `(let ((,var ,form)) - (if (eql ,var :not-available) - :not-available - (progn , at body)))) - ;;; A ``raw form spec'' can be either: ;;; ;;; i) a list of strings representing a Common Lisp form @@ -127,31 +121,31 @@ (parse-first-valid-form-spec raw-specs #'read-conversatively-for-autodoc) (when form-spec (unwind-protect - (with-available-arglist (arglist) - (arglist-from-form-spec form-spec :remove-args nil) - (multiple-value-bind (type operator) - (split-form-spec form-spec) - (let* ((index (nth position arg-indices)) - (stringified-arglist - (decoded-arglist-to-string - arglist - :operator operator - :print-right-margin print-right-margin - :print-lines print-lines - ;; Do not highlight the operator: - :highlight (and index (not (zerop index)) index)))) - ;; Post formatting: - (case type - (:type-specifier (format nil "[Typespec] ~A" stringified-arglist)) - (:declaration - (locally (declare (special *arglist-pprint-bindings*)) - (with-bindings *arglist-pprint-bindings* - ;; Try to print ``(declare (declspec))'' (or ``declaim'' etc.) - (let ((op (%find-declaration-operator raw-specs position))) - (if op - (format nil "(~A ~A)" op stringified-arglist) - (format nil "[Declaration] ~A" stringified-arglist)))))) - (t stringified-arglist))))) + (let ((arglist (arglist-from-form-spec form-spec :remove-args nil))) + (unless (eq arglist :not-available) + (multiple-value-bind (type operator) + (split-form-spec form-spec) + (let* ((index (nth position arg-indices)) + (stringified-arglist + (decoded-arglist-to-string + arglist + :operator operator + :print-right-margin print-right-margin + :print-lines print-lines + ;; Do not highlight the operator: + :highlight (and index (not (zerop index)) index)))) + ;; Post formatting: + (case type + (:type-specifier (format nil "[Typespec] ~A" stringified-arglist)) + (:declaration + (locally (declare (special *arglist-pprint-bindings*)) + (with-bindings *arglist-pprint-bindings* + ;; Try to print ``(declare (declspec))'' (or ``declaim'' etc.) + (let ((op (%find-declaration-operator raw-specs position))) + (if op + (format nil "(~A ~A)" op stringified-arglist) + (format nil "[Declaration] ~A" stringified-arglist)))))) + (t stringified-arglist)))))) (mapc #'unintern-in-home-package newly-interned-symbols))))) (error (cond) (format nil "ARGLIST (error): ~A" cond)) @@ -1100,6 +1094,13 @@ (split-form-spec form-spec) (arglist-dispatch type operator arguments :remove-args remove-args)))) + +(defmacro with-available-arglist ((var) form &body body) + `(let ((,var ,form)) + (if (eql ,var :not-available) + :not-available + (progn , at body)))) + (defgeneric arglist-dispatch (operator-type operator arguments &key remove-args)) (defmethod arglist-dispatch ((operator-type t) operator arguments &key (remove-args t)) --- /project/slime/cvsroot/slime/contrib/ChangeLog 2009/02/02 15:29:33 1.172 +++ /project/slime/cvsroot/slime/contrib/ChangeLog 2009/02/02 18:55:36 1.173 @@ -1,5 +1,11 @@ 2009-02-02 Tobias C. Rittweiler + * swank-arglists.lisp (arglist-for-echo-area): Bleh, can't use + WITH-AVAILABLE-ARGLIST because we're supposed to return NIL, not + :NOT-AVAILABLE, in the failure case. + +2009-02-02 Tobias C. Rittweiler + * slime-parse.el ([test] enclosing-form-specs.1): Fix test case. 2009-02-01 Tobias C. Rittweiler From trittweiler at common-lisp.net Fri Feb 6 23:48:15 2009 From: trittweiler at common-lisp.net (CVS User trittweiler) Date: Fri, 06 Feb 2009 23:48:15 +0000 Subject: [slime-cvs] CVS slime Message-ID: Update of /project/slime/cvsroot/slime In directory cl-net:/tmp/cvs-serv30598 Modified Files: slime.el ChangeLog Log Message: * slime.el (slime-initialize-macroexpansion-buffer): Clear the buffer-undo-list, so the user can't get expansions from earlier macroexpansions into the buffer, screwing up badly. --- /project/slime/cvsroot/slime/slime.el 2009/01/23 10:05:03 1.1119 +++ /project/slime/cvsroot/slime/slime.el 2009/02/06 23:48:14 1.1120 @@ -4948,6 +4948,8 @@ (defun slime-initialize-macroexpansion-buffer (expansion &optional buffer) (pop-to-buffer (or buffer (slime-create-macroexpansion-buffer))) + (setq buffer-undo-list nil) ; Get rid of undo information from + ; previous expansions. (let ((inhibit-read-only t) (buffer-undo-list t)) ; Make the initial insertion not be undoable. (erase-buffer) --- /project/slime/cvsroot/slime/ChangeLog 2009/01/30 09:58:48 1.1674 +++ /project/slime/cvsroot/slime/ChangeLog 2009/02/06 23:48:14 1.1675 @@ -1,3 +1,9 @@ +2009-02-07 Tobias C. Rittweiler + + * slime.el (slime-initialize-macroexpansion-buffer): Clear the + buffer-undo-list, so the user can't get expansions from earlier + macroexpansions into the buffer, screwing up badly. + 2009-01-30 Tobias C. Rittweiler * swank-clisp.lisp (fspec-location): Fix creation of source-location. From trittweiler at common-lisp.net Sat Feb 7 13:19:50 2009 From: trittweiler at common-lisp.net (CVS User trittweiler) Date: Sat, 07 Feb 2009 13:19:50 +0000 Subject: [slime-cvs] CVS slime Message-ID: Update of /project/slime/cvsroot/slime In directory cl-net:/tmp/cvs-serv826 Modified Files: swank-sbcl.lisp ChangeLog Log Message: In Xref, list IR1-conversion functions with :DEF-IR1-TRANSLATOR as prefix rather than DEFUN. (Test case: M-. on FUNCTION.) * swank-sbcl.lisp (definition-specifier): New function. (make-dspec): New function. Splitted from MAKE-SOURCE-LOCATION-SPECIFICATION. --- /project/slime/cvsroot/slime/swank-sbcl.lisp 2009/01/27 14:56:14 1.233 +++ /project/slime/cvsroot/slime/swank-sbcl.lisp 2009/02/07 13:19:50 1.234 @@ -573,6 +573,15 @@ :source-transform :define-source-transform) "Map SB-INTROSPECT definition type names to Slime-friendly forms") +(defun definition-specifier (type name) + "Return a pretty specifier for NAME representing a definition of type TYPE." + (if (and (symbolp name) + (eq type :function) + (sb-int:info :function :ir1-convert name)) + :def-ir1-translator + (getf *definition-types* type))) + + (defimplementation find-definitions (name) (loop for type in *definition-types* by #'cddr for locations = (sb-introspect:find-definition-sources-by-name @@ -610,9 +619,7 @@ (defun make-source-location-specification (type name source-location) - (list (list* (getf *definition-types* type) - name - (sb-introspect::definition-source-description source-location)) + (list (make-dspec type name source-location) (if *debug-definition-finding* (make-definition-source-location source-location type name) (handler-case @@ -620,6 +627,11 @@ (error (e) (list :error (format nil "Error: ~A" e))))))) +(defun make-dspec (type name source-location) + (list* (definition-specifier type name) + name + (sb-introspect::definition-source-description source-location))) + (defun make-definition-source-location (definition-source type name) (with-struct (sb-introspect::definition-source- pathname form-path character-offset plist @@ -1465,4 +1477,4 @@ (multiple-value-bind (rpid status) (sb-posix:waitpid pid 0) (assert (= pid rpid)) (assert (and (sb-posix:wifexited status) - (zerop (sb-posix:wexitstatus status))))))))) \ No newline at end of file + (zerop (sb-posix:wexitstatus status))))))))) --- /project/slime/cvsroot/slime/ChangeLog 2009/02/06 23:48:14 1.1675 +++ /project/slime/cvsroot/slime/ChangeLog 2009/02/07 13:19:50 1.1676 @@ -1,5 +1,14 @@ 2009-02-07 Tobias C. Rittweiler + In Xref, list IR1-conversion functions with :DEF-IR1-TRANSLATOR as + prefix rather than DEFUN. (Test case: M-. on FUNCTION.) + + * swank-sbcl.lisp (definition-specifier): New function. + (make-dspec): New function. Splitted from + MAKE-SOURCE-LOCATION-SPECIFICATION. + +2009-02-07 Tobias C. Rittweiler + * slime.el (slime-initialize-macroexpansion-buffer): Clear the buffer-undo-list, so the user can't get expansions from earlier macroexpansions into the buffer, screwing up badly. From trittweiler at common-lisp.net Wed Feb 11 20:00:57 2009 From: trittweiler at common-lisp.net (CVS User trittweiler) Date: Wed, 11 Feb 2009 20:00:57 +0000 Subject: [slime-cvs] CVS slime Message-ID: Update of /project/slime/cvsroot/slime In directory cl-net:/tmp/cvs-serv17232 Modified Files: slime.el ChangeLog Log Message: * slime.el: Barf if emacs-major-version <= 20. We support 21 and up. (slime-emacs-20-p): Removed. * slime.el (slime-forward-reader-comment): Removed. (slime-forward-any-comment): New; superset of above. (slime-forward-reader-conditional): Make it understand SBCL's #!+,#!- so it works in source files of SBCL itself, too. (slime-current-parser-state): New. --- /project/slime/cvsroot/slime/slime.el 2009/02/06 23:48:14 1.1120 +++ /project/slime/cvsroot/slime/slime.el 2009/02/11 20:00:57 1.1121 @@ -47,6 +47,10 @@ ;;;; Dependencies and setup (eval-and-compile + (when (<= emacs-major-version 20) + (error "Slime requires an Emacs version of 21, or above"))) + +(eval-and-compile (require 'cl) (unless (fboundp 'define-minor-mode) (require 'easy-mmode) @@ -722,8 +726,7 @@ Single-line messages use the echo area." (apply slime-message-function format args)) -(when (or (featurep 'xemacs) - (= emacs-major-version 20)) +(when (or (featurep 'xemacs)) (setq slime-message-function 'slime-format-display-message)) (defun slime-format-display-message (format &rest args) @@ -2163,8 +2166,8 @@ form (:ok VALUE) or (:abort). CLAUSES is executed asynchronously. -Note: don't use backquote syntax for SEXP, because Emacs20 cannot -deal with that." +Note: don't use backquote syntax for SEXP, because various Emacs +versions cannot deal with that." (let ((result (gensym))) `(lexical-let ,(loop for var in saved-vars collect (etypecase var @@ -2977,8 +2980,7 @@ (putp 'slime note) (putp 'face (slime-severity-face severity)) (putp 'severity severity) - (unless (slime-emacs-20-p) - (putp 'mouse-face 'highlight)) + (putp 'mouse-face 'highlight) (putp 'help-echo message) overlay))) @@ -7795,7 +7797,8 @@ (with-current-buffer (sldb-get-default-buffer) (sldb-quit)) (slime-sync-to-top-level 1)) - + +;;; FIXME: reconnection is broken since the recent io-redirection changes. (def-slime-test disconnect () "Close the connetion. @@ -7916,10 +7919,11 @@ (put 'slime-point-moves-p 'lisp-indent-function 0) (defun slime-forward-sexp (&optional count) - "Like `forward-sexp', but understands reader-conditionals (#- and #+)." + "Like `forward-sexp', but understands reader-conditionals (#- and #+), +and skips comments." (dotimes (i (or count 1)) (while (slime-point-moves-p (slime-forward-blanks) - (slime-forward-reader-comment) + (slime-forward-any-comment) (slime-forward-reader-conditional))) (forward-sexp))) @@ -7931,23 +7935,20 @@ ;; newlines aren't in lisp-mode's whitespace syntax class (when (eolp) (forward-char)))))) -;; Emacs 21's forward-sexp understands #| |# comments in lisp-mode -;; buffers, but (at least) Emacs 20's doesn't, so here it is. -(defun slime-forward-reader-comment () - "Move forward over #|...|# reader comments. The comments may be nested." - (when (looking-at "#|") - (goto-char (match-end 0)) - (while (not (looking-at "|#")) - (re-search-forward (regexp-opt '("|#" "#|"))) - (goto-char (match-beginning 0)) - (when (looking-at "#|") ; nested comment - (slime-forward-reader-comment))) - (goto-char (match-end 0)))) +(defun slime-forward-any-comment () + "Skip the whole comment at point, or the comment where point is +within. This includes nested comments (#| ... |#)." + (while (forward-comment 1)) ; We may be exactly in front of a semicolon. + (when-let (comment-start (nth 8 (slime-current-parser-state))) + (goto-char comment-start) + (while (forward-comment 1)))) (defun slime-forward-reader-conditional () "Move past any reader conditional (#+ or #-) at point." - (when (or (looking-at "#\\+") - (looking-at "#-")) + (when (or (looking-at "#[\\+\\-]") + ;; #!+, #!- are SBCL specific reader-conditional syntax. + ;; We need this for the source files of SBCL itself. + (looking-at "#![\\+\\-]")) (goto-char (match-end 0)) (let* ((plus-conditional-p (eq (char-before) ?+)) (result (slime-eval-feature-conditional (read (current-buffer))))) @@ -8030,9 +8031,9 @@ (save-excursion (let ((string (thing-at-point 'slime-symbol))) (and string - ;; In Emacs20 (thing-at-point 'symbol) returns "" instead - ;; of nil when called from an empty (or - ;; narrowed-to-empty) buffer. + ;; (thing-at-point 'symbol) returns "" instead of nil + ;; when called from an empty (or narrowed-to-empty) + ;; buffer. (not (equal string "")) (substring-no-properties string)))))) @@ -8069,15 +8070,23 @@ (when (featurep 'xemacs) (require 'overlay)) +(if (and (featurep 'emacs) (>= emacs-major-version 22)) + ;;; N.B. The 2nd, and 6th return value cannot be relied upon. + (defun slime-current-parser-state () (syntax-ppss)) + (defun slime-current-parser-state () + (let ((original-pos (point))) + (save-excursion + (beginning-of-defun) + (parse-partial-sexp (point) original-pos))))) + (defun slime-split-string (string &optional separators omit-nulls) - "This is like `split-string' in Emacs22, but also works in -Emacs20 and 21." + "This is like `split-string' in Emacs22, but also works in 21." (let ((splits (split-string string separators))) (if omit-nulls (setq splits (remove "" splits)) ;; SPLIT-STRING in Emacs before 22.x automatically removed nulls ;; at beginning and end, so we gotta add them here again. - (when (or (slime-emacs-20-p) (slime-emacs-21-p)) + (when (slime-emacs-21-p) (when (find (elt string 0) separators) (push "" splits)) (when (find (elt string (1- (length string))) separators) @@ -8403,10 +8412,6 @@ (and ,temp-message ,current-message (message "%s" ,current-message))))))) -(defun slime-emacs-20-p () - (and (not (featurep 'xemacs)) - (= emacs-major-version 20))) - (defun slime-emacs-21-p () (and (not (featurep 'xemacs)) (= emacs-major-version 21))) --- /project/slime/cvsroot/slime/ChangeLog 2009/02/07 13:19:50 1.1676 +++ /project/slime/cvsroot/slime/ChangeLog 2009/02/11 20:00:57 1.1677 @@ -1,3 +1,14 @@ +2009-02-11 Tobias C. Rittweiler + + * slime.el: Barf if emacs-major-version <= 20. We support 21 and up. + (slime-emacs-20-p): Removed. + + * slime.el (slime-forward-reader-comment): Removed. + (slime-forward-any-comment): New; superset of above. + (slime-forward-reader-conditional): Make it understand SBCL's + #!+,#!- so it works in source files of SBCL itself, too. + (slime-current-parser-state): New. + 2009-02-07 Tobias C. Rittweiler In Xref, list IR1-conversion functions with :DEF-IR1-TRANSLATOR as From trittweiler at common-lisp.net Wed Feb 11 20:55:01 2009 From: trittweiler at common-lisp.net (CVS User trittweiler) Date: Wed, 11 Feb 2009 20:55:01 +0000 Subject: [slime-cvs] CVS slime Message-ID: Update of /project/slime/cvsroot/slime In directory cl-net:/tmp/cvs-serv27729 Modified Files: slime.el ChangeLog Log Message: * slime.el (slime-current-tlf, slime-current-form-path): New functions; can be handy when inspecting source-locations while debugging M-. --- /project/slime/cvsroot/slime/slime.el 2009/02/11 20:00:57 1.1121 +++ /project/slime/cvsroot/slime/slime.el 2009/02/11 20:55:01 1.1122 @@ -3059,6 +3059,47 @@ (goto-char (point-min)) (slime-forward-source-path source-path)) +;;; The following two functions can be handy when inspecting +;;; source-location while debugging `M-.'. +;;; +(defun slime-current-tlf-number () + "Return the current toplevel number." + (interactive) + (let ((original-pos (car (slime-region-for-defun-at-point))) + (n 0)) + (save-excursion + ;; We use this and no repeated `beginning-of-defun's to get + ;; reader conditionals right. + (goto-char (point-min)) + (while (progn (slime-forward-sexp) + (< (point) original-pos)) + (incf n))) + n)) + +;;; This is similiar to `slime-enclosing-form-paths' in the +;;; `slime-parse' contrib except that this does not do any duck-tape +;;; parsing, and gets reader conditionals right. +(defun slime-current-form-path () + "Returns the path from the beginning of the current toplevel +form to the atom at point, or nil if we're in front of a tlf." + (interactive) + (let ((source-path nil)) + (save-excursion + ;; Moving forward to get reader conditionals right. + (loop for inner-pos = (point) + for outer-pos = (nth-value 1 (syntax-ppss)) + while outer-pos do + (goto-char outer-pos) + (unless (eq (char-before) ?#) ; when at #(...) continue. + (forward-char) + (let ((n 0)) + (while (progn (slime-forward-sexp) + (< (point) inner-pos)) + (incf n)) + (push n source-path) + (goto-char outer-pos))))) + source-path)) + (defun slime-forward-positioned-source-path (source-path) "Move forward through a sourcepath from a fixed position. The point is assumed to already be at the outermost sexp, making the @@ -7938,10 +7979,10 @@ (defun slime-forward-any-comment () "Skip the whole comment at point, or the comment where point is within. This includes nested comments (#| ... |#)." - (while (forward-comment 1)) ; We may be exactly in front of a semicolon. + (forward-comment (buffer-size)) ; We may be exactly in front of a semicolon. (when-let (comment-start (nth 8 (slime-current-parser-state))) (goto-char comment-start) - (while (forward-comment 1)))) + (forward-comment (buffer-size)))) (defun slime-forward-reader-conditional () "Move past any reader conditional (#+ or #-) at point." --- /project/slime/cvsroot/slime/ChangeLog 2009/02/11 20:00:57 1.1677 +++ /project/slime/cvsroot/slime/ChangeLog 2009/02/11 20:55:01 1.1678 @@ -1,5 +1,11 @@ 2009-02-11 Tobias C. Rittweiler + * slime.el (slime-current-tlf, slime-current-form-path): New + functions; can be handy when inspecting source-locations while + debugging M-. + +2009-02-11 Tobias C. Rittweiler + * slime.el: Barf if emacs-major-version <= 20. We support 21 and up. (slime-emacs-20-p): Removed. From heller at common-lisp.net Sat Feb 14 12:33:17 2009 From: heller at common-lisp.net (CVS User heller) Date: Sat, 14 Feb 2009 12:33:17 +0000 Subject: [slime-cvs] CVS slime Message-ID: Update of /project/slime/cvsroot/slime In directory cl-net:/tmp/cvs-serv16185 Modified Files: ChangeLog slime.el Log Message: * slime.el (slime-restart-or-init-modeline-update-timer): Don't run the timer repeatedly. (slime-change-directory): Also change the directory in the connection-buffer. --- /project/slime/cvsroot/slime/ChangeLog 2009/02/11 20:55:01 1.1678 +++ /project/slime/cvsroot/slime/ChangeLog 2009/02/14 12:33:16 1.1679 @@ -51,6 +51,13 @@ Patch by Stas Boukarev. +2009-01-30 Helmut Eller + + * slime.el (slime-restart-or-init-modeline-update-timer): Don't + run the timer repeatedly. + (slime-change-directory): Also change the directory in the + connection-buffer. + 2009-01-23 Tobias C. Rittweiler * slime.el (slime-editing-keys): New variable; splitted from --- /project/slime/cvsroot/slime/slime.el 2009/02/11 20:55:01 1.1122 +++ /project/slime/cvsroot/slime/slime.el 2009/02/14 12:33:17 1.1123 @@ -468,7 +468,7 @@ (when slime-modeline-update-timer (cancel-timer slime-modeline-update-timer)) (setq slime-modeline-update-timer - (run-with-idle-timer 0.5 0.5 'slime-update-all-modelines))) + (run-with-idle-timer 0.1 nil 'slime-update-all-modelines))) (slime-restart-or-init-modeline-update-timer) @@ -4444,6 +4444,7 @@ (let ((dir (expand-file-name directory))) (prog1 (slime-eval `(swank:set-default-directory ,(slime-to-lisp-filename dir))) + (slime-with-connection-buffer nil (cd-absolute dir)) (run-hook-with-args 'slime-change-directory-hooks dir)))) (defun slime-cd (directory) From heller at common-lisp.net Sat Feb 14 12:33:28 2009 From: heller at common-lisp.net (CVS User heller) Date: Sat, 14 Feb 2009 12:33:28 +0000 Subject: [slime-cvs] CVS slime Message-ID: Update of /project/slime/cvsroot/slime In directory cl-net:/tmp/cvs-serv16223 Modified Files: ChangeLog swank-backend.lisp swank-cmucl.lisp swank.lisp Log Message: Don't signal conditions in the interrupt handler to avoid problems with naive code like (handler-case foo (condition bar)) * swank-backend.lisp (*interrupt-queued-handler*): Use a dynamic variable instead. (slime-interrupt-queued): Deleted. * swank-cmucl.lisp, swank.lisp: Ditto. --- /project/slime/cvsroot/slime/ChangeLog 2009/02/14 12:33:16 1.1679 +++ /project/slime/cvsroot/slime/ChangeLog 2009/02/14 12:33:27 1.1680 @@ -51,6 +51,17 @@ Patch by Stas Boukarev. +2009-02-14 Helmut Eller + + Don't signal conditions in interrupt handler to + avoid problems with naive code like + (handler-case foo (condition bar)) + + * swank-backend.lisp (*interrupt-queued-handler*): Use a dynamic + variable instead. + (slime-interrupt-queued): Deleted. + * swank-cmucl.lisp, swank.lisp: Ditto. + 2009-01-30 Helmut Eller * slime.el (slime-restart-or-init-modeline-update-timer): Don't --- /project/slime/cvsroot/slime/swank-backend.lisp 2009/01/27 14:56:14 1.171 +++ /project/slime/cvsroot/slime/swank-backend.lisp 2009/02/14 12:33:28 1.172 @@ -35,7 +35,7 @@ ;; interrupt macro for the backend #:*pending-slime-interrupts* #:check-slime-interrupts - #:slime-interrupt-queued + #:*interrupt-queued-handler* ;; inspector related symbols #:emacs-inspect #:label-value-line @@ -1065,11 +1065,12 @@ (funcall (pop *pending-slime-interrupts*)) t)) -(define-condition slime-interrupt-queued () () - (:documentation - "Non-serious condition signalled when an interrupt -occurs while interrupt handling is disabled. -Backends can use this to abort blocking operations.")) +(defvar *interrupt-queued-handler* nil + "Function to call on queued interrupts. +Interrupts get queued when an interrupt occurs while interrupt +handling is disabled. + +Backends can use this function to abort slow operations.") (definterface wait-for-input (streams &optional timeout) "Wait for input on a list of streams. Return those that are ready. --- /project/slime/cvsroot/slime/swank-cmucl.lisp 2009/01/10 12:25:16 1.210 +++ /project/slime/cvsroot/slime/swank-cmucl.lisp 2009/02/14 12:33:28 1.211 @@ -203,8 +203,8 @@ (handlers (loop for s in (cons in (mapcar #'to-fd-stream streams)) collect (add-one-shot-handler s f)))) (unwind-protect - (handler-bind ((slime-interrupt-queued - (lambda (c) c (write-char #\! out)))) + (let ((*interrupt-queued-handler* (lambda () + (write-char #\! out)))) (when (check-slime-interrupts) (return :interrupt)) (sys:serve-event)) (mapc #'sys:remove-fd-handler handlers) --- /project/slime/cvsroot/slime/swank.lisp 2009/01/16 15:49:48 1.633 +++ /project/slime/cvsroot/slime/swank.lisp 2009/02/14 12:33:28 1.634 @@ -427,7 +427,8 @@ (check-slime-interrupts)) (t (log-event "queue-interrupt: ~a" function) - (signal 'slime-interrupt-queued)))))) + (when *interrupt-queued-handler* + (funcall *interrupt-queued-handler*))))))) (defslimefun simple-break (&optional (datum "Interrupt from Emacs") &rest args) (with-simple-restart (continue "Continue from break.") @@ -2366,7 +2367,9 @@ FORM is expected, but not required, to be SETF'able." ;; FIXME: Can we check FORM for setfability? -luke (12/Mar/2005) (with-buffer-syntax () - (prin1-to-string (eval (read-from-string form))))) + (let* ((value (eval (read-from-string form))) + (*print-length* nil)) + (prin1-to-string value)))) (defslimefun commit-edited-value (form value) "Set the value of a setf'able FORM to VALUE. @@ -2488,7 +2491,7 @@ `(or (:emacs-rex . _) (:sldb-return ,(1+ level)))) ((:emacs-rex &rest args) (apply #'eval-for-emacs args)) - ((:sldb-return _) (declare (ignore _)) (return nil))) + ((:sldb-return _) (declare (ignore _)) (return nil))) (sldb-condition (c) (handle-sldb-condition c)))))) (send-to-emacs `(:debug-return From heller at common-lisp.net Sat Feb 14 12:33:36 2009 From: heller at common-lisp.net (CVS User heller) Date: Sat, 14 Feb 2009 12:33:36 +0000 Subject: [slime-cvs] CVS slime Message-ID: Update of /project/slime/cvsroot/slime In directory cl-net:/tmp/cvs-serv16271 Modified Files: ChangeLog Log Message: *** empty log message *** --- /project/slime/cvsroot/slime/ChangeLog 2009/02/14 12:33:27 1.1680 +++ /project/slime/cvsroot/slime/ChangeLog 2009/02/14 12:33:36 1.1681 @@ -1,3 +1,21 @@ +2009-02-14 Helmut Eller + + Don't signal conditions in interrupt handler to + avoid problems with naive code like + (handler-case foo (condition bar)) + + * swank-backend.lisp (*interrupt-queued-handler*): Use a dynamic + variable instead. + (slime-interrupt-queued): Deleted. + * swank-cmucl.lisp, swank.lisp: Ditto. + +2009-02-14 Helmut Eller + + * slime.el (slime-restart-or-init-modeline-update-timer): Don't + run the timer repeatedly. + (slime-change-directory): Also change the directory in the + connection-buffer. + 2009-02-11 Tobias C. Rittweiler * slime.el (slime-current-tlf, slime-current-form-path): New @@ -51,24 +69,6 @@ Patch by Stas Boukarev. -2009-02-14 Helmut Eller - - Don't signal conditions in interrupt handler to - avoid problems with naive code like - (handler-case foo (condition bar)) - - * swank-backend.lisp (*interrupt-queued-handler*): Use a dynamic - variable instead. - (slime-interrupt-queued): Deleted. - * swank-cmucl.lisp, swank.lisp: Ditto. - -2009-01-30 Helmut Eller - - * slime.el (slime-restart-or-init-modeline-update-timer): Don't - run the timer repeatedly. - (slime-change-directory): Also change the directory in the - connection-buffer. - 2009-01-23 Tobias C. Rittweiler * slime.el (slime-editing-keys): New variable; splitted from From heller at common-lisp.net Sat Feb 14 12:59:32 2009 From: heller at common-lisp.net (CVS User heller) Date: Sat, 14 Feb 2009 12:59:32 +0000 Subject: [slime-cvs] CVS slime/contrib Message-ID: Update of /project/slime/cvsroot/slime/contrib In directory cl-net:/tmp/cvs-serv19800 Modified Files: ChangeLog Added Files: swank.rb Log Message: swank.rb: New file. --- /project/slime/cvsroot/slime/contrib/ChangeLog 2009/02/02 18:55:36 1.173 +++ /project/slime/cvsroot/slime/contrib/ChangeLog 2009/02/14 12:59:32 1.174 @@ -1,3 +1,7 @@ +2009-02-14 Helmut Eller + + * swank.rb: New file. + 2009-02-02 Tobias C. Rittweiler * swank-arglists.lisp (arglist-for-echo-area): Bleh, can't use --- /project/slime/cvsroot/slime/contrib/swank.rb 2009/02/14 12:59:32 NONE +++ /project/slime/cvsroot/slime/contrib/swank.rb 2009/02/14 12:59:32 1.1 # swank.rb --- swank server for Ruby. # # This is my first Ruby program and looks probably rather strange. Some # people write Scheme interpreters when learning new languages, I # write swank backends. # # Only a few things work. # 1. Start the server with something like: ruby -r swank -e swank # 2. Use M-x slime-connect to establish a connection require "socket" def swank(port=4005) accept_connections port, false end def start_swank(port_file) accept_connections false, port_file end def accept_connections(port, port_file) server = TCPServer.new("localhost", port || 0) puts "Listening on #{server.addr.inspect}\n" if port_file write_port_file server.addr[1], port_file end socket = begin server.accept ensure server.close end begin serve socket.to_io ensure socket.close end end def write_port_file(port, filename) File.open(filename, File::CREAT|File::EXCL|File::WRONLY) do |f| f.puts port end end def serve(io) main_loop(io) end def main_loop(io) c = Connection.new(io) while true catch :swank_top_level do c.dispatch(read_packet(io)) end end end class Connection def initialize(io) @io = io end def dispatch(event) puts "dispatch: %s\n" % event.inspect case event[0] when :":emacs-rex" emacs_rex *event[1..4] else raise "Unhandled event: #{event.inspect}" end end def send_to_emacs(obj) payload = write_sexp_to_string(obj) @io.write("%06x" % payload.length) @io.write payload @io.flush end def emacs_rex(form, pkg, thread, id) proc = $rpc_entries[form[0]] args = form[1..-1]; begin raise "Undefined function: #{form[0]}" unless proc value = proc[*args] rescue Exception => exc begin pseudo_debug exc ensure send_to_emacs [:":return", [:":abort"], id] end else send_to_emacs [:":return", [:":ok", value], id] end end def pseudo_debug(exc) level = 1 send_to_emacs [:":debug", 0, level] + sldb_info(exc, 0, 20) begin sldb_loop exc ensure send_to_emacs [:":debug-return", 0, level, :nil] end end def sldb_loop(exc) $sldb_context = [self,exc] while true dispatch(read_packet(@io)) end end def sldb_info(exc, start, _end) [[exc.to_s, " [%s]" % exc.class.name, :nil], sldb_restarts(exc), sldb_backtrace(exc, start, _end), []] end def sldb_restarts(exc) [["Quit", "SLIME top-level."]] end def sldb_backtrace(exc, start, _end) bt = [] exc.backtrace[start.._end].each_with_index do |frame, i| bt << [i, frame] end bt end def frame_src_loc(exc, frame) string = exc.backtrace[frame] match = /([^:]+):([0-9]+)/.match(string) if match file,line = match[1..2] [:":location", [:":file", file], [:":line", line.to_i], :nil] else [:":error", "no src-loc for frame: #{string}"] end end end $rpc_entries = Hash.new $rpc_entries[:"swank:connection-info"] = lambda do || [:":pid", $$, :":package", [:":name", "ruby", :":prompt", "ruby> "], :":lisp-implementation", [:":type", "Ruby", :":name", "ruby", :":version", RUBY_VERSION]] end def swank_interactive_eval(string) eval(string,TOPLEVEL_BINDING).inspect end $rpc_entries[:"swank:interactive-eval"] = \ $rpc_entries[:"swank:interactive-eval-region"] = \ $rpc_entries[:"swank:pprint-eval"] = lambda { |string| swank_interactive_eval string } $rpc_entries[:"swank:throw-to-toplevel"] = lambda { throw :swank_top_level } $rpc_entries[:"swank:backtrace"] = lambda do |from, to| conn, exc = $sldb_context conn.sldb_backtrace(exc, from, to) end $rpc_entries[:"swank:frame-source-location-for-emacs"] = lambda do |frame| conn, exc = $sldb_context conn.frame_src_loc(exc, frame) end #ignored $rpc_entries[:"swank:buffer-first-change"] = \ $rpc_entries[:"swank:operator-arglist"] = lambda do :nil end $rpc_entries[:"swank:simple-completions"] = lambda do |prefix, pkg| swank_simple_completions prefix, pkg end # def swank_simple_completions(prefix, pkg) def read_packet(io) header = read_chunk(io, 6) len = header.hex payload = read_chunk(io, len) #$deferr.puts payload.inspect read_sexp_from_string(payload) end def read_chunk(io, len) buffer = io.read(len) raise "short read" if buffer.length != len buffer end def write_sexp_to_string(obj) string = "" write_sexp_to_string_loop obj, string string end def write_sexp_to_string_loop(obj, string) if obj.is_a? String string << "\"" string << obj.gsub(/(["\\])/,'\\\\\1') string << "\"" elsif obj.is_a? Array string << "(" max = obj.length-1 obj.each_with_index do |e,i| write_sexp_to_string_loop e, string string << " " unless i == max end string << ")" elsif obj.is_a? Symbol or obj.is_a? Numeric string << obj.to_s elsif obj == false string << "nil" elsif obj == true string << "t" else raise "Can't write: #{obj.inspect}" end end def read_sexp_from_string(string) stream = StringInputStream.new(string) reader = LispReader.new(stream) reader.read end class LispReader def initialize(io) @io = io end def read(allow_consing_dot=false) skip_whitespace c = @io.getc case c when ?( then read_list(true) when ?" then read_string when ?' then read_quote when nil then raise EOFError.new("EOF during read") else @io.ungetc(c) obj = read_number_or_symbol if obj == :"." and not allow_consing_dot raise "Consing-dot in invalid context" end obj end end def read_list(head) list = [] loop do skip_whitespace c = @io.readchar if c == ?) break else @io.ungetc(c) obj = read(!head) if obj == :"." error "Consing-dot not implemented" # would need real conses end head = false list << obj end end list end def read_string string = "" loop do c = @io.getc case c when ?" break when ?\\ c = @io.getc case c when ?\\, ?" then string << c else raise "Invalid escape char: \\%c" % c end else string << c end end string end def read_quote [:quote, read] end def read_number_or_symbol token = read_token if token.empty? raise EOFError.new elsif /^[0-9]+$/.match(token) token.to_i elsif /^[0-9]+\.[0-9]+$/.match(token) token.to_f else token.intern end end def read_token token = "" loop do c = @io.getc if c.nil? break elsif terminating?(c) @io.ungetc(c) break else token << c end end token end def skip_whitespace loop do c = @io.getc case c when ?\s, ?\n, ?\t then next when nil then break else @io.ungetc(c); break end end end def terminating?(char) " \n\t()\"'".include?(char) end end class StringInputStream def initialize(string) @string = string @pos = 0 @max = string.length end def pos() @pos end def getc if @pos == @max nil else c = @string[@pos] @pos += 1 c end end def readchar getc or raise EOFError.new end def ungetc(c) if @pos > 0 && @string[@pos-1] == c @pos -= 1 else raise "Invalid argument: %c [at %d]" % [c, @pos] end end end From trittweiler at common-lisp.net Sat Feb 14 17:01:53 2009 From: trittweiler at common-lisp.net (CVS User trittweiler) Date: Sat, 14 Feb 2009 17:01:53 +0000 Subject: [slime-cvs] CVS slime Message-ID: Update of /project/slime/cvsroot/slime In directory cl-net:/tmp/cvs-serv28777 Modified Files: ChangeLog Log Message: * slime.el (slime-reader-conditionals-regexp): New variable. Taken from `slime-forward-reader-conditional'. (slime-pretty-package-name): Fix modeline display for buffer containing forms like (in-package "#+foo :A #-foo :B"). Also do not call `read' on the name; the function does not need to return a symbol, and `read' may choke on non-elisp syntax. --- /project/slime/cvsroot/slime/ChangeLog 2009/02/14 12:33:36 1.1681 +++ /project/slime/cvsroot/slime/ChangeLog 2009/02/14 17:01:52 1.1682 @@ -1,3 +1,12 @@ +2009-02-14 Tobias C. Rittweiler + + * slime.el (slime-reader-conditionals-regexp): New variable. Taken + from `slime-forward-reader-conditional'. + (slime-pretty-package-name): Fix modeline display for buffer + containing forms like (in-package "#+foo :A #-foo :B"). Also do + not call `read' on the name; the function does not need to return + a symbol, and `read' may choke on non-elisp syntax. + 2009-02-14 Helmut Eller Don't signal conditions in interrupt handler to From heller at common-lisp.net Tue Feb 17 09:03:42 2009 From: heller at common-lisp.net (CVS User heller) Date: Tue, 17 Feb 2009 09:03:42 +0000 Subject: [slime-cvs] CVS slime Message-ID: Update of /project/slime/cvsroot/slime In directory cl-net:/tmp/cvs-serv8100 Modified Files: ChangeLog slime.el swank.lisp Log Message: * swank.lisp (dispatch-event [:emacs-rex]): Reply a :invalid-rpc message if the specified thread doesn't exist. * slime.el (slime-dispatch-event): Handle :invalid-rpc. (slime-init-connection-state): Bind slime-current-thread to avoid problems with dead threads. --- /project/slime/cvsroot/slime/ChangeLog 2009/02/14 17:01:52 1.1682 +++ /project/slime/cvsroot/slime/ChangeLog 2009/02/17 09:03:41 1.1683 @@ -1,3 +1,11 @@ +2009-02-17 Helmut Eller + + * swank.lisp (dispatch-event [:emacs-rex]): Reply a :invalid-rpc + message if the specified thread doesn't exist. + * slime.el (slime-dispatch-event): Handle :invalid-rpc. + (slime-init-connection-state): Bind slime-current-thread + to avoid problems with dead threads. + 2009-02-14 Tobias C. Rittweiler * slime.el (slime-reader-conditionals-regexp): New variable. Taken --- /project/slime/cvsroot/slime/slime.el 2009/02/14 12:33:17 1.1123 +++ /project/slime/cvsroot/slime/slime.el 2009/02/17 09:03:41 1.1124 @@ -1989,8 +1989,9 @@ ;; function may be called from a timer, and if we setup the REPL ;; from a timer then it mysteriously uses the wrong keymap for the ;; first command. - (slime-eval-async '(swank:connection-info) - (slime-curry #'slime-set-connection-info proc))) + (let ((slime-current-thread t)) + (slime-eval-async '(swank:connection-info) + (slime-curry #'slime-set-connection-info proc)))) (defun slime-set-connection-info (connection info) "Initialize CONNECTION with INFO received from Lisp." @@ -2397,9 +2398,11 @@ (princ (format "Invalid protocol message:\n%s\n\n%S" condition packet)) (goto-char (point-min))) - (error "Invalid protocol message"))))) - ;; Canonicalized return value. See comment in `slime-eval-async'. - :slime-dispatch-event) + (error "Invalid protocol message")) + ((:invalid-rpc id message) + (setf (slime-rex-continuations) + (remove* id (slime-rex-continuations) :key #'car)) + (error "Invalid rpc: %s" message)))))) (defun slime-send (sexp) "Send SEXP directly over the wire on the current connection." --- /project/slime/cvsroot/slime/swank.lisp 2009/02/14 12:33:28 1.634 +++ /project/slime/cvsroot/slime/swank.lisp 2009/02/17 09:03:41 1.635 @@ -1151,8 +1151,14 @@ (destructure-case event ((:emacs-rex form package thread-id id) (let ((thread (thread-for-evaluation thread-id))) - (push thread *active-threads*) - (send-event thread `(:emacs-rex ,form ,package ,id)))) + (cond (thread + (push thread *active-threads*) + (send-event thread `(:emacs-rex ,form ,package ,id))) + (t + (encode-message + (list :invalid-rpc id + (format nil "Thread not found: ~s" thread-id)) + (current-socket-io)))))) ((:return thread &rest args) (let ((tail (member thread *active-threads*))) (setq *active-threads* (nconc (ldiff *active-threads* tail) From heller at common-lisp.net Tue Feb 17 09:03:46 2009 From: heller at common-lisp.net (CVS User heller) Date: Tue, 17 Feb 2009 09:03:46 +0000 Subject: [slime-cvs] CVS slime/contrib Message-ID: Update of /project/slime/cvsroot/slime/contrib In directory cl-net:/tmp/cvs-serv8139/contrib Modified Files: ChangeLog slime-repl.el Log Message: * slime-repl.el (slime-repl-connected-hook-function): Bind slime-current-thread to avoid problems with killed threads. --- /project/slime/cvsroot/slime/contrib/ChangeLog 2009/02/14 12:59:32 1.174 +++ /project/slime/cvsroot/slime/contrib/ChangeLog 2009/02/17 09:03:46 1.175 @@ -1,3 +1,8 @@ +2009-02-17 Helmut Eller + + * slime-repl.el (slime-repl-connected-hook-function): Bind + slime-current-thread to avoid problems with killed threads. + 2009-02-14 Helmut Eller * swank.rb: New file. --- /project/slime/cvsroot/slime/contrib/slime-repl.el 2009/01/27 15:13:52 1.14 +++ /project/slime/cvsroot/slime/contrib/slime-repl.el 2009/02/17 09:03:46 1.15 @@ -1499,7 +1499,8 @@ (defun slime-repl-connected-hook-function () (destructuring-bind (package prompt) - (slime-eval '(swank:create-repl nil)) + (let ((slime-current-thread t)) + (slime-eval '(swank:create-repl nil))) (setf (slime-lisp-package) package) (setf (slime-lisp-package-prompt-string) prompt)) (slime-hide-inferior-lisp-buffer) From trittweiler at common-lisp.net Sat Feb 21 19:05:22 2009 From: trittweiler at common-lisp.net (CVS User trittweiler) Date: Sat, 21 Feb 2009 19:05:22 +0000 Subject: [slime-cvs] CVS slime/contrib Message-ID: Update of /project/slime/cvsroot/slime/contrib In directory cl-net:/tmp/cvs-serv7449/contrib Modified Files: ChangeLog slime-package-fu.el Log Message: * slime-package-fu.el: Removed misplaced comma, deleted some end-of-line whitespace, added newline to the end of the file. Patch by Robert Brown. --- /project/slime/cvsroot/slime/contrib/ChangeLog 2009/02/17 09:03:46 1.175 +++ /project/slime/cvsroot/slime/contrib/ChangeLog 2009/02/21 19:05:21 1.176 @@ -1,3 +1,10 @@ +2009-02-21 Tobias C. Rittweiler + + * slime-package-fu.el: Removed misplaced comma, deleted some + end-of-line whitespace, added newline to the end of the file. + + Patch by Robert Brown. + 2009-02-17 Helmut Eller * slime-repl.el (slime-repl-connected-hook-function): Bind --- /project/slime/cvsroot/slime/contrib/slime-package-fu.el 2008/11/29 11:12:39 1.3 +++ /project/slime/cvsroot/slime/contrib/slime-package-fu.el 2009/02/21 19:05:22 1.4 @@ -6,13 +6,13 @@ ;; (defvar slime-package-file-candidates - (mapcar #'file-name-nondirectory + (mapcar #'file-name-nondirectory '("package.lisp" "packages.lisp" "pkgdcl.lisp" "defpackage.lisp"))) -(defvar slime-export-symbol-representation-function +(defvar slime-export-symbol-representation-function #'(lambda (n) (format "#:%s" n))) -(defvar slime-defpackage-regexp +(defvar slime-defpackage-regexp "^(\\(cl:\\|common-lisp:\\)?defpackage\\>[ \t']*") @@ -26,7 +26,7 @@ (block nil (while (re-search-forward slime-defpackage-regexp nil t) (when (slime-package-equal package (slime-sexp-at-point)) - (return (make-slime-file-location ,(buffer-file-name) (point))))))))) + (return (make-slime-file-location (buffer-file-name) (point))))))))) (defun slime-package-equal (designator1 designator2) ;; First try to be lucky and compare the strings themselves (for the @@ -48,7 +48,7 @@ (defun slime-find-possible-package-file (buffer-file-name) (flet ((file-name-subdirectory (dirname) - (expand-file-name + (expand-file-name (concat (file-name-as-directory (slime-to-lisp-filename dirname)) (file-name-as-directory "..")))) (try (dirname) @@ -85,7 +85,7 @@ (while (ignore-errors (slime-forward-sexp) t) (slime-forward-blanks) (when (slime-at-expression-p '(:export *)) - (setq point (point)) + (setq point (point)) (return))))) (if point (goto-char point) @@ -138,11 +138,11 @@ (when point (goto-char point)) point))) (let ((defpackage-point (point)) - (symbol-name (funcall slime-export-symbol-representation-function + (symbol-name (funcall slime-export-symbol-representation-function symbol-name))) (cond ((goto-last-export-clause) (down-list) (slime-end-of-list) - (unless (looking-back "^\\s-*") + (unless (looking-back "^\\s-*") (newline-and-indent)) (insert symbol-name)) (t @@ -169,7 +169,7 @@ the symbol again. Additionally performs an EXPORT/UNEXPORT of the symbol in the Lisp image if possible." (interactive) - (let ((package (slime-current-package)) + (let ((package (slime-current-package)) (symbol (slime-symbol-name-at-point))) (unless symbol (error "No symbol at point.")) (cond (current-prefix-arg @@ -197,4 +197,4 @@ (while slime-c-p-c-init-undo-stack (eval (pop slime-c-p-c-init-undo-stack)))) -(provide 'slime-package-fu) \ No newline at end of file +(provide 'slime-package-fu) From trittweiler at common-lisp.net Sun Feb 22 14:18:48 2009 From: trittweiler at common-lisp.net (CVS User trittweiler) Date: Sun, 22 Feb 2009 14:18:48 +0000 Subject: [slime-cvs] CVS slime Message-ID: Update of /project/slime/cvsroot/slime In directory cl-net:/tmp/cvs-serv16652 Modified Files: slime.el swank-backend.lisp swank.lisp Log Message: `M-x slime-format-string-expand' displays the expansion of a format string. * slime.el (slime-string-at-point) New. (slime-string-at-point-or-error): New. (slime-format-string-expand): New; use them. * swank-backend.lisp (format-string-expand): New interface. * swank.lisp (swank-format-string-expand): New; use it. --- /project/slime/cvsroot/slime/slime.el 2009/02/17 09:03:41 1.1124 +++ /project/slime/cvsroot/slime/slime.el 2009/02/22 14:18:47 1.1125 @@ -4962,6 +4962,18 @@ (remap 'advertised-undo 'slime-macroexpand-undo) (remap 'undo 'slime-macroexpand-undo)) +(defun slime-macroexpand-undo (&optional arg) + (interactive) + (flet ((undo-only (arg) + ;; Emacs 22.x introduced `undo-only' which works by binding + ;; `undo-no-redo' to t. We do it this way so we don't break + ;; prior Emacs versions. + (let ((undo-no-redo t)) (undo arg)))) + (let ((inhibit-read-only t)) + (when (fboundp 'slime-remove-edits) + (slime-remove-edits (point-min) (point-max))) + (undo-only arg)))) + (defun slime-sexp-at-point-for-macroexpansion () "Essentially like SLIME-SEXP-AT-POINT-OR-ERROR, but behaves a bit more sanely in situations like ,(loop ...) where you want to @@ -4993,6 +5005,13 @@ (slime-eval-async slime-eval-macroexpand-expression #'slime-initialize-macroexpansion-buffer))) +(defun slime-macroexpand-again () + "Reperform the last macroexpansion." + (interactive) + (slime-eval-async slime-eval-macroexpand-expression + (slime-rcurry #'slime-initialize-macroexpansion-buffer + (current-buffer)))) + (defun slime-initialize-macroexpansion-buffer (expansion &optional buffer) (pop-to-buffer (or buffer (slime-create-macroexpansion-buffer))) (setq buffer-undo-list nil) ; Get rid of undo information from @@ -5073,25 +5092,11 @@ (interactive) (slime-eval-macroexpand 'swank:swank-compiler-macroexpand-1)) -(defun slime-macroexpand-again () - "Reperform the last macroexpansion." - (interactive) - (slime-eval-async slime-eval-macroexpand-expression - (slime-rcurry #'slime-initialize-macroexpansion-buffer - (current-buffer)))) - -(defun slime-macroexpand-undo (&optional arg) +(defun slime-format-string-expand () + "Format the format-string at point, and display its expansion." (interactive) - (flet ((undo-only (arg) - ;; Emacs 22.x introduced `undo-only' which works by binding - ;; `undo-no-redo' to t. We do it this way so we don't break - ;; prior Emacs versions. - (let ((undo-no-redo t)) (undo arg)))) - (let ((inhibit-read-only t)) - (when (fboundp 'slime-remove-edits) - (slime-remove-edits (point-min) (point-max))) - (undo-only arg)))) - + (slime-eval-macroexpand 'swank:swank-format-string-expand + (slime-string-at-point-or-error))) ;;;; Subprocess control @@ -8089,8 +8094,18 @@ (defun slime-sexp-at-point-or-error () "Return the sexp at point as a string, othwise signal an error." - (or (slime-sexp-at-point) - (error "No expression at point."))) + (or (slime-sexp-at-point) (error "No expression at point."))) + +(defun slime-string-at-point () + "Returns the string at point as a string, otherwise nil." + (let ((sexp (slime-sexp-at-point))) + (if (eql (char-syntax (aref sexp 0)) ?\") + sexp + nil))) + +(defun slime-string-at-point-or-error () + "Return the sexp at point as a string, othwise signal an error." + (or (slime-string-at-point) (error "No string at point."))) (defun slime-input-complete-p (start end) "Return t if the region from START to END contains a complete sexp." --- /project/slime/cvsroot/slime/swank-backend.lisp 2009/02/14 12:33:28 1.172 +++ /project/slime/cvsroot/slime/swank-backend.lisp 2009/02/22 14:18:47 1.173 @@ -581,6 +581,10 @@ (values new-form expanded))))) (frob form env))) +(definterface format-string-expand (control-string) + "Expand the format string CONTROL-STRING." + (macroexpand `(formatter ,control-string))) + (definterface describe-symbol-for-emacs (symbol) "Return a property list describing SYMBOL. --- /project/slime/cvsroot/slime/swank.lisp 2009/02/17 09:03:41 1.635 +++ /project/slime/cvsroot/slime/swank.lisp 2009/02/22 14:18:47 1.636 @@ -2895,6 +2895,9 @@ (defslimefun swank-compiler-macroexpand (string) (apply-macro-expander #'compiler-macroexpand string)) +(defslimefun swank-format-string-expand (string) + (apply-macro-expander #'format-string-expand string)) + (defslimefun disassemble-symbol (name) (with-buffer-syntax () (with-output-to-string (*standard-output*) From trittweiler at common-lisp.net Tue Feb 24 16:51:46 2009 From: trittweiler at common-lisp.net (CVS User trittweiler) Date: Tue, 24 Feb 2009 16:51:46 +0000 Subject: [slime-cvs] CVS slime Message-ID: Update of /project/slime/cvsroot/slime In directory cl-net:/tmp/cvs-serv2548 Modified Files: ChangeLog Log Message: `M-x slime-format-string-expand' displays the expansion of a format string. * slime.el (slime-string-at-point) New. (slime-string-at-point-or-error): New. (slime-format-string-expand): New; use them. * swank-backend.lisp (format-string-expand): New interface. * swank.lisp (swank-format-string-expand): New; use it. --- /project/slime/cvsroot/slime/ChangeLog 2009/02/17 09:03:41 1.1683 +++ /project/slime/cvsroot/slime/ChangeLog 2009/02/24 16:51:46 1.1684 @@ -1,3 +1,15 @@ +2009-02-22 2009-02-14 Tobias C. Rittweiler + + `M-x slime-format-string-expand' displays the expansion of a + format string. + + * slime.el (slime-string-at-point) New. + (slime-string-at-point-or-error): New. + (slime-format-string-expand): New; use them. + + * swank-backend.lisp (format-string-expand): New interface. + * swank.lisp (swank-format-string-expand): New; use it. + 2009-02-17 Helmut Eller * swank.lisp (dispatch-event [:emacs-rex]): Reply a :invalid-rpc From trittweiler at common-lisp.net Tue Feb 24 17:24:07 2009 From: trittweiler at common-lisp.net (CVS User trittweiler) Date: Tue, 24 Feb 2009 17:24:07 +0000 Subject: [slime-cvs] CVS slime Message-ID: Update of /project/slime/cvsroot/slime In directory cl-net:/tmp/cvs-serv8967 Modified Files: ChangeLog slime.el Log Message: Re-checkin my change from 2009-02-14. It seems I didn't actually commit it. --- /project/slime/cvsroot/slime/ChangeLog 2009/02/24 16:51:46 1.1684 +++ /project/slime/cvsroot/slime/ChangeLog 2009/02/24 17:24:07 1.1685 @@ -1,4 +1,9 @@ -2009-02-22 2009-02-14 Tobias C. Rittweiler +2009-02-24 Tobias C. Rittweiler + + Re-checkin my change from 2009-02-14. It seems I didn't actually + commit it. + +2009-02-22 Tobias C. Rittweiler `M-x slime-format-string-expand' displays the expansion of a format string. --- /project/slime/cvsroot/slime/slime.el 2009/02/22 14:18:47 1.1125 +++ /project/slime/cvsroot/slime/slime.el 2009/02/24 17:24:07 1.1126 @@ -401,8 +401,19 @@ (match-string 1 name)) ((string-match "^\"\\(.*\\)\"$" name) (match-string 1 name)) - (t name)))) - (format "%s" (read name)))) + ((string-match slime-reader-conditionals-regexp name) + ;; This is kind of a sledge hammer, but as it's a rare + ;; case we don't care. + (with-temp-buffer + (insert name) + (goto-char (point-min)) + (slime-forward-sexp) ; skip reader conditionals + (let ((old (point))) + (backward-sexp) + (buffer-substring-no-properties (point) old)))) + (t + (error "FALL THROUGH"))))) + (format "%s" name))) (defun slime-compute-modeline-connection () (let ((conn (slime-current-connection))) @@ -7993,12 +8004,14 @@ (goto-char comment-start) (forward-comment (buffer-size)))) +(defvar slime-reader-conditionals-regexp + ;; #!+, #!- are SBCL specific reader-conditional syntax. + ;; We need this for the source files of SBCL itself. + (regexp-opt '("#+" "#-" "#!+" "#!-"))) + (defun slime-forward-reader-conditional () "Move past any reader conditional (#+ or #-) at point." - (when (or (looking-at "#[\\+\\-]") - ;; #!+, #!- are SBCL specific reader-conditional syntax. - ;; We need this for the source files of SBCL itself. - (looking-at "#![\\+\\-]")) + (when (looking-at slime-reader-conditionals-regexp) (goto-char (match-end 0)) (let* ((plus-conditional-p (eq (char-before) ?+)) (result (slime-eval-feature-conditional (read (current-buffer))))) From trittweiler at common-lisp.net Tue Feb 24 17:43:15 2009 From: trittweiler at common-lisp.net (CVS User trittweiler) Date: Tue, 24 Feb 2009 17:43:15 +0000 Subject: [slime-cvs] CVS slime Message-ID: Update of /project/slime/cvsroot/slime In directory cl-net:/tmp/cvs-serv12476 Modified Files: ChangeLog slime.el Log Message: * slime.el (slime-forward-cruft): Forward whitespace, reader conditonals, comments. Splitted from `slime-forward-sexp'. (slime-pretty-package-name): Use it. --- /project/slime/cvsroot/slime/ChangeLog 2009/02/24 17:24:07 1.1685 +++ /project/slime/cvsroot/slime/ChangeLog 2009/02/24 17:43:15 1.1686 @@ -1,5 +1,11 @@ 2009-02-24 Tobias C. Rittweiler + * slime.el (slime-forward-cruft): Forward whitespace, reader + conditonals, comments. Splitted from `slime-forward-sexp'. + (slime-pretty-package-name): Use it. + +2009-02-24 Tobias C. Rittweiler + Re-checkin my change from 2009-02-14. It seems I didn't actually commit it. --- /project/slime/cvsroot/slime/slime.el 2009/02/24 17:24:07 1.1126 +++ /project/slime/cvsroot/slime/slime.el 2009/02/24 17:43:15 1.1127 @@ -407,12 +407,11 @@ (with-temp-buffer (insert name) (goto-char (point-min)) - (slime-forward-sexp) ; skip reader conditionals - (let ((old (point))) - (backward-sexp) - (buffer-substring-no-properties (point) old)))) - (t - (error "FALL THROUGH"))))) + (slime-forward-cruft) + (if (eobp) ; Skipped all reader conditionals? + name ; If so, do nothing. + (slime-pretty-package-name (slime-sexp-at-point))))) + (t (error "FALL THROUGH"))))) (format "%s" name))) (defun slime-compute-modeline-connection () @@ -7983,11 +7982,15 @@ "Like `forward-sexp', but understands reader-conditionals (#- and #+), and skips comments." (dotimes (i (or count 1)) - (while (slime-point-moves-p (slime-forward-blanks) - (slime-forward-any-comment) - (slime-forward-reader-conditional))) + (slime-forward-cruft) (forward-sexp))) +(defun slime-forward-cruft () + "Move forward over whitespace, comments, reader conditionals." + (while (slime-point-moves-p (slime-forward-blanks) + (slime-forward-any-comment) + (slime-forward-reader-conditional)))) + (defun slime-forward-blanks () "Move forward over all whitespace and newlines at point." (ignore-errors From loliveira at common-lisp.net Wed Feb 25 17:53:27 2009 From: loliveira at common-lisp.net (CVS User loliveira) Date: Wed, 25 Feb 2009 17:53:27 +0000 Subject: [slime-cvs] CVS slime Message-ID: Update of /project/slime/cvsroot/slime In directory cl-net:/tmp/cvs-serv26085 Modified Files: ChangeLog Log Message: * contrib/slime-compiler-notes-tree.el: Fix typo in the `provide' form. --- /project/slime/cvsroot/slime/ChangeLog 2009/02/24 17:43:15 1.1686 +++ /project/slime/cvsroot/slime/ChangeLog 2009/02/25 17:53:27 1.1687 @@ -1,3 +1,8 @@ +2009-02-25 Lu?s Oliveira + + * contrib/slime-compiler-notes-tree.el: Fix typo in the `provide' + form. + 2009-02-24 Tobias C. Rittweiler * slime.el (slime-forward-cruft): Forward whitespace, reader From loliveira at common-lisp.net Wed Feb 25 17:54:38 2009 From: loliveira at common-lisp.net (CVS User loliveira) Date: Wed, 25 Feb 2009 17:54:38 +0000 Subject: [slime-cvs] CVS slime/contrib Message-ID: Update of /project/slime/cvsroot/slime/contrib In directory cl-net:/tmp/cvs-serv26215/contrib Modified Files: slime-compiler-notes-tree.el Log Message: * contrib/slime-compiler-notes-tree.el: Fix typo in the `provide' form. --- /project/slime/cvsroot/slime/contrib/slime-compiler-notes-tree.el 2009/01/08 10:37:51 1.1 +++ /project/slime/cvsroot/slime/contrib/slime-compiler-notes-tree.el 2009/02/25 17:54:38 1.2 @@ -1,4 +1,4 @@ -;; slime-complete-notes-tree.el --- Display compiler messages in tree layout. +;; slime-compiler-notes-tree.el --- Display compiler messages in tree layout. ;; ;; Author: Helmut Eller ;; License: GNU GPL (same license as Emacs) @@ -180,4 +180,4 @@ (delete-char 1) (goto-char start-mark))) -(provide 'slime-complete-notes-tree) \ No newline at end of file +(provide 'slime-compiler-notes-tree) From trittweiler at common-lisp.net Thu Feb 26 18:29:58 2009 From: trittweiler at common-lisp.net (CVS User trittweiler) Date: Thu, 26 Feb 2009 18:29:58 +0000 Subject: [slime-cvs] CVS slime Message-ID: Update of /project/slime/cvsroot/slime In directory cl-net:/tmp/cvs-serv28014 Modified Files: ChangeLog slime.el Log Message: * slime.el ([test] fancy-symbol-names): New, hopefully comprehensive, test for funky symbol names. (slime-check-fancy-symbol-name): Helper. (slime-exit-vertical-bars): New function to move out from |foo|. (slime-symbol-constituent-at): New predicate to test whether the character at point is a valid symbol constituent. (slime-beginning-of-symbol, slime-end-of-symbol): Rewritten using above two functions and `forward-sexp' that correctly parses escapes etc. (slime-sexp-at-point): Consider thing at point a symbol first. --- /project/slime/cvsroot/slime/ChangeLog 2009/02/25 17:53:27 1.1687 +++ /project/slime/cvsroot/slime/ChangeLog 2009/02/26 18:29:58 1.1688 @@ -1,7 +1,15 @@ -2009-02-25 Lu?s Oliveira +2009-02-26 Tobias C. Rittweiler - * contrib/slime-compiler-notes-tree.el: Fix typo in the `provide' - form. + * slime.el ([test] fancy-symbol-names): New, hopefully + comprehensive, test for funky symbol names. + (slime-check-fancy-symbol-name): Helper. + (slime-exit-vertical-bars): New function to move out from |foo|. + (slime-symbol-constituent-at): New predicate to test whether the + character at point is a valid symbol constituent. + (slime-beginning-of-symbol, slime-end-of-symbol): Rewritten using + above two functions and `forward-sexp' that correctly parses + escapes etc. + (slime-sexp-at-point): Consider thing at point a symbol first. 2009-02-24 Tobias C. Rittweiler --- /project/slime/cvsroot/slime/slime.el 2009/02/24 17:43:15 1.1127 +++ /project/slime/cvsroot/slime/slime.el 2009/02/26 18:29:58 1.1128 @@ -1,3 +1,4 @@ + ;;; slime.el --- Superior Lisp Interaction Mode for Emacs ;; ;;;; License @@ -57,6 +58,7 @@ (defalias 'define-minor-mode 'easy-mmode-define-minor-mode)) (when (locate-library "hyperspec") (require 'hyperspec))) +(require 'thingatpt) (require 'comint) (require 'timer) (require 'pp) @@ -7313,9 +7315,56 @@ (defun slime-sldb-level= (level) (equal level (sldb-level))) +(defun slime-check-fancy-symbol-name (buffer-offset symbol-name) + ;; We test that `slime-symbol-name-at-point' works at every + ;; character of the symbol name. + (dotimes (pt (length symbol-name)) + (setq pt (+ buffer-offset pt)) + (goto-char pt) + (slime-check ("Checking `%s' (%d)..." (buffer-string) pt) + (equal (slime-symbol-name-at-point) symbol-name)))) + +(def-slime-test fancy-symbol-names (symbol-name) + "Check that we can cope with idiosyncratic symbol names." + '(("foobar") ("foo at bar") ("@foobar") ("foobar@") ("\\@foobar") + ("|asdf,@@@(foo[adsf])asdf!!!|::|fo||bar|asdf") + ("|asdf||foo||bar|") + ("\\|foo|bar|@asdf:foo|\\||") + ("\\\\\\\\foo|barfo\\\\|asdf") + ) + (slime-check-top-level) + (with-temp-buffer + (lisp-mode) + (slime-test-message "*** fancy symbol-name at BOB and EOB:") + (insert symbol-name) + (slime-check-fancy-symbol-name (point-min) symbol-name) + (erase-buffer) + + (slime-test-message "*** fancy symbol-name _not_ at BOB/EOB:") + (insert "(foo ") (insert symbol-name) (insert " bar)") + (slime-check-fancy-symbol-name (+ (point-min) 5) symbol-name) + (erase-buffer) + + (unless (eq (aref symbol-name 0) ?\@) ; Skip on `@foobar' + (slime-test-message "*** fancy symbol-name with leading ,:") + (insert ",") (insert symbol-name) + (slime-check-fancy-symbol-name (+ (point-min) 1) symbol-name) + (erase-buffer)) + + (slime-test-message "*** fancy symbol-name with leading ,@:") + (insert ",@") (insert symbol-name) + (slime-check-fancy-symbol-name (+ (point-min) 2) symbol-name) + (erase-buffer) + + (slime-test-message "*** fancy symbol-name wrapped in ():") + (insert "(") (insert symbol-name) (insert ")") + (slime-check-fancy-symbol-name (+ (point-min) 1) symbol-name) + (erase-buffer) + )) + (def-slime-test narrowing () - "Check that narrowing is properly sustained." - '(()) + "Check that narrowing is properly sustained." + '() (slime-check-top-level) (let ((random-buffer-name (symbol-name (gensym))) (defun-pos) (tmpbuffer)) @@ -7360,7 +7409,7 @@ (= (point) defun-pos))) (slime-check "Checking that narrowing sustained after M-," - (slime-buffer-narrowed-p))) + (slime-buffer-narrowed-p))) )) (slime-check-top-level)) @@ -8056,24 +8105,54 @@ (beginning-of-defun) (list (point) end))))) +(defun slime-exit-vertical-bars () + "Move out from within vertical bars (|foo|) to the leading bar." + (let* ((parser-state (slime-current-parser-state)) + (in-string-p (nth 3 parser-state)) + (string-start (nth 8 parser-state))) + (when (and in-string-p + (eq (char-after string-start) ?\|)) + (goto-char string-start)))) + +(defun slime-symbol-constituent-at (pos) + "Is the character at position POS a valid symbol constituent?" + (when-let (char (char-after pos)) ; nil when at eob. + (let* ((char-before (or (char-before pos) ?\a)) ; nil when at bob. + (syntax (char-syntax char)) + (syntax-before (char-syntax char-before))) + ;; We assume we're not within vertical bars. + (or + (memq syntax '(?\w ?\_ ?\\)) ; usual suspects? + (eq char ?\|) + (eq syntax-before ?\\) ; escaped? + (and (eq char ?\@) ; ,@@foobar or foo at bar? + (not (eq char-before ?\,))))))) + +;;; `slime-beginning-of-symbol', and `slime-end-of-symbol' are written +;;; to get a lot of funky CL-style symbol names right (see +;;; `fancy-symbol-names' test.) To get them right, we have to use +;;; `forward-sexp' as that one does properly heed escaping etc. +;;; (defun slime-beginning-of-symbol () - "Move point to the beginning of the current symbol." - (when (slime-point-moves-p - (while (slime-point-moves-p - (skip-syntax-backward "w_") - (when (eq (char-before) ?|) - (backward-char))))) - (when (eq (char-before) ?#) ; special case for things like "# Update of /project/slime/cvsroot/slime/contrib In directory cl-net:/tmp/cvs-serv28499/contrib Modified Files: ChangeLog slime-enclosing-context.el slime-parse.el Log Message: * slime-parse.el (slime-parse-symbol-name-at-point): Removed. Superfluous due to recent changes on `slime-symbol-name-at-point'. (slime-parse-sexp-at-point): Simplified; use `slime-sexp-at-point'. (slime-inside-string-p, slime-beginning-of-string): Use `slime-current-parser-state'. ([test] enclosing-form-specs.1): Add some simple cases. * slime-enclosing-context.el (slime-find-bound-names): Replace `slime-parse-symbol-name-at-point' with `slime-symbol-name-at-point' (slime-find-bound-functions): No need for `slime-ensure-list' anymore. ([test] enclosing-context.1): Adapted due to the changes. --- /project/slime/cvsroot/slime/contrib/ChangeLog 2009/02/21 19:05:21 1.176 +++ /project/slime/cvsroot/slime/contrib/ChangeLog 2009/02/26 18:35:43 1.177 @@ -1,3 +1,25 @@ +2009-02-26 Tobias C. Rittweiler + + * slime-parse.el (slime-parse-symbol-name-at-point): + Removed. Superfluous due to recent changes on + `slime-symbol-name-at-point'. + (slime-parse-sexp-at-point): Simplified; use + `slime-sexp-at-point'. + (slime-inside-string-p, slime-beginning-of-string): Use + `slime-current-parser-state'. + ([test] enclosing-form-specs.1): Add some simple cases. + + * slime-enclosing-context.el (slime-find-bound-names): Replace + `slime-parse-symbol-name-at-point' with + `slime-symbol-name-at-point' + (slime-find-bound-functions): No need for `slime-ensure-list' + anymore. + ([test] enclosing-context.1): Adapted due to the changes. + +2009-02-25 Lu?s Oliveira + + * slime-compiler-notes-tree.el: Fix typo in the `provide' form. + 2009-02-21 Tobias C. Rittweiler * slime-package-fu.el: Removed misplaced comma, deleted some --- /project/slime/cvsroot/slime/contrib/slime-enclosing-context.el 2009/01/18 14:18:53 1.3 +++ /project/slime/cvsroot/slime/contrib/slime-enclosing-context.el 2009/02/26 18:35:43 1.4 @@ -54,7 +54,7 @@ (ignore-errors (loop (down-list) - (push (slime-parse-symbol-name-at-point 1) binding-names) + (push (slime-symbol-name-at-point) binding-names) (push (save-excursion (backward-up-list) (point)) binding-start-points) (up-list))))) @@ -81,8 +81,8 @@ (ignore-errors (loop (down-list) - (destructuring-bind (name arglist) - (slime-ensure-list (slime-parse-sexp-at-point 2)) + (destructuring-bind (name arglist) + (slime-parse-sexp-at-point 2) (assert (slime-has-symbol-syntax-p name)) (assert arglist) (push name names) (push arglist arglists) @@ -100,8 +100,16 @@ '(("(flet ((,nil ())) (let ((bar 13) (,foo 42)) - *HERE*))" - (",nil" "bar" ",foo") + *HERE*))" + ;; We used to return ,foo here, but we do not anymore. We + ;; still return ,nil for the `slime-enclosing-bound-functions', + ;; though. The first one is used for local M-., whereas the + ;; latter is used for local autodoc. It does not seem too + ;; important for local M-. to work on such names. \(The reason + ;; that it does not work anymore, is that + ;; `slime-symbol-name-at-point' now does TRT and does not + ;; return a leading comma anymore.\) + ("bar" nil nil) ((",nil" "()"))) ("(flet ((foo ())) (quux) --- /project/slime/cvsroot/slime/contrib/slime-parse.el 2009/02/02 15:29:33 1.15 +++ /project/slime/cvsroot/slime/contrib/slime-parse.el 2009/02/26 18:35:43 1.16 @@ -27,11 +27,9 @@ (concat (slime-incomplete-sexp-at-point) ")")))))))) (defun slime-parse-sexp-at-point (&optional n skip-blanks-p) - "Return the sexp at point as a string, otherwise nil. -If N is given and greater than 1, a list of all such sexps -following the sexp at point is returned. (If there are not -as many sexps as N, a list with < N sexps is returned.) - + "Returns the sexps at point as a list of strings, otherwise nil. +\(If there are not as many sexps as N, a list with < N sexps is +returned.\) If SKIP-BLANKS-P is true, leading whitespaces &c are skipped. " (interactive "p") (or n (setq n 1)) @@ -42,38 +40,25 @@ (or (thing-at-point 'sexp) (slime-symbol-name-at-point))))) (if string (substring-no-properties string) nil)))) - ;; `thing-at-point' depends upon the current syntax table; otherwise - ;; keywords like `:foo' are not recognized as sexps. (This function - ;; may be called from temporary buffers etc.) - (with-syntax-table lisp-mode-syntax-table - (save-excursion - (when skip-blanks-p ; e.g. `( foo bat)' where point is after ?\(. - (slime-forward-blanks)) - (let ((result nil)) - (dotimes (i n) - ;; `foo(bar baz)' where point is at ?\( or ?\). - (if (and (char-after) (member (char-syntax (char-after)) '(?\( ?\) ?\'))) - (push (sexp-at-point :sexp-first) result) - (push (sexp-at-point :symbol-first) result)) - (ignore-errors (forward-sexp) (slime-forward-blanks)) - (save-excursion - (unless (slime-point-moves-p (ignore-errors (forward-sexp))) - (return)))) - (if (slime-length= result 1) - (first result) - (nreverse result))))))) + (save-excursion + (when skip-blanks-p ; e.g. `( foo bat)' where point is after ?\(. + (slime-forward-blanks)) + (let ((result nil)) + (dotimes (i n) + (push (slime-sexp-at-point) result) + ;; Skip current sexp + (ignore-errors (forward-sexp) (slime-forward-blanks)) + ;; Is there an additional sexp in front of us? + (save-excursion + (unless (slime-point-moves-p (ignore-errors (forward-sexp))) + (return)))) + (nreverse result))))) (defun slime-has-symbol-syntax-p (string) (if (and string (not (zerop (length string)))) (member (char-syntax (aref string 0)) '(?w ?_ ?\' ?\\)))) -(defun slime-parse-symbol-name-at-point (&optional n skip-blanks-p) - (let ((symbols (slime-parse-sexp-at-point n skip-blanks-p))) - (if (every #'slime-has-symbol-syntax-p (slime-ensure-list symbols)) - symbols - nil))) - (defun slime-incomplete-sexp-at-point (&optional n) (interactive "p") (or n (setq n 1)) (buffer-substring-no-properties (save-excursion (backward-up-list n) (point)) @@ -136,7 +121,7 @@ (not (= (point) ; point is at end of form? (save-excursion (slime-end-of-list) (point))))) - (let* ((args (slime-ensure-list (slime-parse-sexp-at-point n))) + (let* ((args (slime-parse-sexp-at-point n)) (arg-specs (mapcar #'slime-make-form-spec-from-string args))) (setq current-forms (cons `(,name , at arg-specs) old-forms)))) (values current-forms current-indices current-points) @@ -231,8 +216,7 @@ (mapcar #'(lambda (s) (assert (not (equal s string))) ; trap against (slime-make-form-spec-from-string s)) ; endless recursion. - (slime-ensure-list - (slime-parse-sexp-at-point (1+ n) t)))))))))) + (slime-parse-sexp-at-point (1+ n) t))))))))) (defun slime-enclosing-form-specs (&optional max-levels) @@ -310,7 +294,7 @@ (when (member (char-syntax (char-after)) '(?\( ?')) (incf level) (forward-char 1) - (let ((name (slime-parse-symbol-name-at-point 1 nil))) + (let ((name (slime-symbol-name-at-point))) (cond (name (save-restriction @@ -339,23 +323,25 @@ (if (listp thing) thing (list thing))) (defun slime-inside-string-p () - (let* ((toplevel-begin (save-excursion (beginning-of-defun) (point))) - (parse-result (parse-partial-sexp toplevel-begin (point))) - (inside-string-p (nth 3 parse-result)) - (string-start-pos (nth 8 parse-result))) - (and inside-string-p string-start-pos))) + (nth 3 (slime-current-parser-state))) (defun slime-beginning-of-string () - (let ((string-start-pos (slime-inside-string-p))) - (if string-start-pos - (goto-char string-start-pos) - (error "We're not within a string")))) + (let* ((parser-state (slime-current-parser-state)) + (inside-string-p (nth 3 parser-state)) + (string-start-pos (nth 8 parser-state))) + (if inside-string-p + (goto-char string-start-pos) + (error "We're not within a string")))) (def-slime-test enclosing-form-specs.1 (buffer-sexpr wished-form-specs) "" - '(("(defmethod *HERE*)" (("defmethod"))) - ("(cerror foo *HERE*)" (("cerror" "foo")))) + '(("(defun *HERE*" (("defun"))) + ("(defun foo *HERE*" (("defun"))) + ("(defun foo (x y) *HERE*" (("defun"))) + ("(defmethod *HERE*)" (("defmethod"))) + ("(defmethod foo *HERE*)" (("defmethod" "foo"))) + ("(cerror foo *HERE*)" (("cerror" "foo")))) (slime-check-top-level) (with-temp-buffer (let ((tmpbuf (current-buffer))) From trittweiler at common-lisp.net Thu Feb 26 18:37:21 2009 From: trittweiler at common-lisp.net (CVS User trittweiler) Date: Thu, 26 Feb 2009 18:37:21 +0000 Subject: [slime-cvs] CVS slime Message-ID: Update of /project/slime/cvsroot/slime In directory cl-net:/tmp/cvs-serv28708 Modified Files: ChangeLog slime.el Log Message: * slime.el (slime-current-form-path): Use `slime-current-parser-state'. --- /project/slime/cvsroot/slime/ChangeLog 2009/02/26 18:29:58 1.1688 +++ /project/slime/cvsroot/slime/ChangeLog 2009/02/26 18:37:21 1.1689 @@ -1,5 +1,10 @@ 2009-02-26 Tobias C. Rittweiler + * slime.el (slime-current-form-path): Use + `slime-current-parser-state'. + +2009-02-26 Tobias C. Rittweiler + * slime.el ([test] fancy-symbol-names): New, hopefully comprehensive, test for funky symbol names. (slime-check-fancy-symbol-name): Helper. --- /project/slime/cvsroot/slime/slime.el 2009/02/26 18:29:58 1.1128 +++ /project/slime/cvsroot/slime/slime.el 2009/02/26 18:37:21 1.1129 @@ -3102,7 +3102,7 @@ (save-excursion ;; Moving forward to get reader conditionals right. (loop for inner-pos = (point) - for outer-pos = (nth-value 1 (syntax-ppss)) + for outer-pos = (nth-value 1 (slime-current-parser-state)) while outer-pos do (goto-char outer-pos) (unless (eq (char-before) ?#) ; when at #(...) continue. From trittweiler at common-lisp.net Thu Feb 26 18:41:23 2009 From: trittweiler at common-lisp.net (CVS User trittweiler) Date: Thu, 26 Feb 2009 18:41:23 +0000 Subject: [slime-cvs] CVS slime Message-ID: Update of /project/slime/cvsroot/slime In directory cl-net:/tmp/cvs-serv31010 Modified Files: ChangeLog slime.el Log Message: * slime.el (slime-pretty-package-name): Signalled an error on simple symbols; fix that! Reported by Geoff Wozniak. --- /project/slime/cvsroot/slime/ChangeLog 2009/02/26 18:37:21 1.1689 +++ /project/slime/cvsroot/slime/ChangeLog 2009/02/26 18:41:23 1.1690 @@ -1,5 +1,12 @@ 2009-02-26 Tobias C. Rittweiler + * slime.el (slime-pretty-package-name): Signalled an error on + simple symbols; fix that! + + Reported by Geoff Wozniak. + +2009-02-26 Tobias C. Rittweiler + * slime.el (slime-current-form-path): Use `slime-current-parser-state'. --- /project/slime/cvsroot/slime/slime.el 2009/02/26 18:37:21 1.1129 +++ /project/slime/cvsroot/slime/slime.el 2009/02/26 18:41:23 1.1130 @@ -411,9 +411,10 @@ (goto-char (point-min)) (slime-forward-cruft) (if (eobp) ; Skipped all reader conditionals? - name ; If so, do nothing. + name ; If so, return the garbage! (slime-pretty-package-name (slime-sexp-at-point))))) - (t (error "FALL THROUGH"))))) + (t ; Normal symbol, or some garbage. + name)))) (format "%s" name))) (defun slime-compute-modeline-connection () From trittweiler at common-lisp.net Thu Feb 26 19:57:35 2009 From: trittweiler at common-lisp.net (CVS User trittweiler) Date: Thu, 26 Feb 2009 19:57:35 +0000 Subject: [slime-cvs] CVS slime Message-ID: Update of /project/slime/cvsroot/slime In directory cl-net:/tmp/cvs-serv11037 Modified Files: swank-backend.lisp ChangeLog Log Message: * swank-backend.lisp (warn-unimplemented-interfaces): Bind *PRINT-PRETTY* to T. Otherwise no sugar formatting on CCL. --- /project/slime/cvsroot/slime/swank-backend.lisp 2009/02/22 14:18:47 1.173 +++ /project/slime/cvsroot/slime/swank-backend.lisp 2009/02/26 19:57:35 1.174 @@ -173,8 +173,9 @@ (defun warn-unimplemented-interfaces () "Warn the user about unimplemented backend features. The portable code calls this function at startup." - (warn "These Swank interfaces are unimplemented:~% ~:<~{~A~^ ~:_~}~:>" - (list (sort (copy-list *unimplemented-interfaces*) #'string<)))) + (let ((*print-pretty* t)) + (warn "These Swank interfaces are unimplemented:~% ~:<~{~A~^ ~:_~}~:>" + (list (sort (copy-list *unimplemented-interfaces*) #'string<))))) (defun import-to-swank-mop (symbol-list) (dolist (sym symbol-list) --- /project/slime/cvsroot/slime/ChangeLog 2009/02/26 18:41:23 1.1690 +++ /project/slime/cvsroot/slime/ChangeLog 2009/02/26 19:57:35 1.1691 @@ -1,5 +1,10 @@ 2009-02-26 Tobias C. Rittweiler + * swank-backend.lisp (warn-unimplemented-interfaces): + Bind *PRINT-PRETTY* to T. Otherwise no sugar formatting on CCL. + +2009-02-26 Tobias C. Rittweiler + * slime.el (slime-pretty-package-name): Signalled an error on simple symbols; fix that! From trittweiler at common-lisp.net Thu Feb 26 20:53:07 2009 From: trittweiler at common-lisp.net (CVS User trittweiler) Date: Thu, 26 Feb 2009 20:53:07 +0000 Subject: [slime-cvs] CVS slime Message-ID: Update of /project/slime/cvsroot/slime In directory cl-net:/tmp/cvs-serv22004 Modified Files: swank.lisp ChangeLog Log Message: * swank.lisp (hash-table-to-alist): New function. ([method] emacs-inspect (hash-table)): Sort keys if they're all numbers, symbols, or strings. Adapted from Willem Broekema. --- /project/slime/cvsroot/slime/swank.lisp 2009/02/22 14:18:47 1.636 +++ /project/slime/cvsroot/slime/swank.lisp 2009/02/26 20:53:07 1.637 @@ -3476,6 +3476,12 @@ ;;;;; Hashtables +(defun hash-table-to-alist (ht) + (let ((result '())) + (maphash #'(lambda (key value) + (setq result (acons key value result))) + ht) + result)) (defmethod emacs-inspect ((ht hash-table)) (append @@ -3492,13 +3498,17 @@ `((:action "[clear hashtable]" ,(lambda () (clrhash ht))) (:newline) "Contents: " (:newline))) - (loop for key being the hash-keys of ht - for value being the hash-values of ht - append `((:value ,key) " = " (:value ,value) - " " (:action "[remove entry]" - ,(let ((key key)) - (lambda () (remhash key ht)))) - (:newline))))) + (let ((content (hash-table-to-alist ht))) + (cond ((every (lambda (x) (typep (first x) '(or string symbol))) content) + (setf content (sort content 'string< :key #'first))) + ((every (lambda (x) (typep (first x) 'number)) content) + (setf content (sort content '< :key #'first)))) + (loop for (key . value) in content appending + `((:value ,key) " = " (:value ,value) + " " (:action "[remove entry]" + ,(let ((key key)) + (lambda () (remhash key ht)))) + (:newline)))))) ;;;;; Arrays --- /project/slime/cvsroot/slime/ChangeLog 2009/02/26 19:57:35 1.1691 +++ /project/slime/cvsroot/slime/ChangeLog 2009/02/26 20:53:07 1.1692 @@ -1,5 +1,13 @@ 2009-02-26 Tobias C. Rittweiler + * swank.lisp (hash-table-to-alist): New function. + ([method] emacs-inspect (hash-table)): Sort keys if they're all + numbers, symbols, or strings. + + Adapted from Willem Broekema. + +2009-02-26 Tobias C. Rittweiler + * swank-backend.lisp (warn-unimplemented-interfaces): Bind *PRINT-PRETTY* to T. Otherwise no sugar formatting on CCL. From trittweiler at common-lisp.net Thu Feb 26 21:19:45 2009 From: trittweiler at common-lisp.net (CVS User trittweiler) Date: Thu, 26 Feb 2009 21:19:45 +0000 Subject: [slime-cvs] CVS slime Message-ID: Update of /project/slime/cvsroot/slime In directory cl-net:/tmp/cvs-serv25410 Modified Files: swank.lisp ChangeLog Log Message: * swank.lisp (debug-in-emacs): Moved (WITH-BINDINGS *SLDB-PRINTER-BINDINGS* ...), from here... (sldb-loop): ... to here. Otherwise results from a user doing an eval-in-frame were truncated. Reported by Jeff Workman. --- /project/slime/cvsroot/slime/swank.lisp 2009/02/26 20:53:07 1.637 +++ /project/slime/cvsroot/slime/swank.lisp 2009/02/26 21:19:45 1.638 @@ -2479,8 +2479,9 @@ (force-user-output) (call-with-debugging-environment (lambda () - (with-bindings *sldb-printer-bindings* - (sldb-loop *sldb-level*)))))) + ;; We used to have (WITH-BINDING *SLDB-PRINTER-BINDINGS* ...) + ;; here, but that truncated the result of an eval-in-frame. + (sldb-loop *sldb-level*))))) (defun sldb-loop (level) (unwind-protect @@ -2488,7 +2489,8 @@ (with-simple-restart (abort "Return to sldb level ~D." level) (send-to-emacs (list* :debug (current-thread-id) level - (debugger-info-for-emacs 0 *sldb-initial-frames*))) + (with-bindings *sldb-printer-bindings* + (debugger-info-for-emacs 0 *sldb-initial-frames*)))) (send-to-emacs (list :debug-activate (current-thread-id) level nil)) (loop --- /project/slime/cvsroot/slime/ChangeLog 2009/02/26 20:53:07 1.1692 +++ /project/slime/cvsroot/slime/ChangeLog 2009/02/26 21:19:45 1.1693 @@ -1,5 +1,14 @@ 2009-02-26 Tobias C. Rittweiler + * swank.lisp (debug-in-emacs): Moved (WITH-BINDINGS + *SLDB-PRINTER-BINDINGS* ...), from here... + (sldb-loop): ... to here. Otherwise results from a user doing an + eval-in-frame were truncated. + + Reported by Jeff Workman. + +2009-02-26 Tobias C. Rittweiler + * swank.lisp (hash-table-to-alist): New function. ([method] emacs-inspect (hash-table)): Sort keys if they're all numbers, symbols, or strings. From trittweiler at common-lisp.net Thu Feb 26 21:41:28 2009 From: trittweiler at common-lisp.net (CVS User trittweiler) Date: Thu, 26 Feb 2009 21:41:28 +0000 Subject: [slime-cvs] CVS slime Message-ID: Update of /project/slime/cvsroot/slime In directory cl-net:/tmp/cvs-serv31299 Modified Files: slime.el ChangeLog Log Message: * slime.el (sldb-backward-frame): Only move backward when we're below the backtrace marker. --- /project/slime/cvsroot/slime/slime.el 2009/02/26 18:41:23 1.1130 +++ /project/slime/cvsroot/slime/slime.el 2009/02/26 21:41:28 1.1131 @@ -5573,10 +5573,11 @@ (goto-char (next-single-char-property-change (point) 'frame))) (defun sldb-backward-frame () - (goto-char (previous-single-char-property-change - (car (sldb-frame-region)) - 'frame - nil sldb-backtrace-start-marker))) + (when (> (point) sldb-backtrace-start-marker) + (goto-char (previous-single-char-property-change + (car (sldb-frame-region)) + 'frame + nil sldb-backtrace-start-marker)))) (defun sldb-goto-last-frame () (goto-char (point-max)) --- /project/slime/cvsroot/slime/ChangeLog 2009/02/26 21:19:45 1.1693 +++ /project/slime/cvsroot/slime/ChangeLog 2009/02/26 21:41:28 1.1694 @@ -1,5 +1,10 @@ 2009-02-26 Tobias C. Rittweiler + * slime.el (sldb-backward-frame): Only move backward when we're + below the backtrace marker. + +2009-02-26 Tobias C. Rittweiler + * swank.lisp (debug-in-emacs): Moved (WITH-BINDINGS *SLDB-PRINTER-BINDINGS* ...), from here... (sldb-loop): ... to here. Otherwise results from a user doing an From trittweiler at common-lisp.net Thu Feb 26 21:50:00 2009 From: trittweiler at common-lisp.net (CVS User trittweiler) Date: Thu, 26 Feb 2009 21:50:00 +0000 Subject: [slime-cvs] CVS slime/doc Message-ID: Update of /project/slime/cvsroot/slime/doc In directory cl-net:/tmp/cvs-serv31780/doc Modified Files: slime.texi Log Message: * doc/slime.texi: Fix typos, and add keybindings not listed there. Patch by Stas Boukarev. --- /project/slime/cvsroot/slime/doc/slime.texi 2009/01/10 12:21:09 1.68 +++ /project/slime/cvsroot/slime/doc/slime.texi 2009/02/26 21:50:00 1.69 @@ -12,7 +12,7 @@ @set EDITION 3.0-alpha @set SLIMEVER 3.0-alpha @c @set UPDATED @today{} - at set UPDATED @code{$Date: 2009/01/10 12:21:09 $} + at set UPDATED @code{$Date: 2009/02/26 21:50:00 $} @set TITLE SLIME User Manual @settitle @value{TITLE}, version @value{EDITION} @@ -503,9 +503,12 @@ (sbcl ("/opt/sbcl/bin/sbcl") :coding-system utf-8-unix))) @end lisp + at vindex slime-default-lisp This variable holds a list of programs and if you invoke @SLIME{} with a negative prefix argument, @kbd{M-- M-x slime}, you can select a -program from that list. The elements of the list should look like +program from that list. When called without a prefix, either the name +specified in @code{slime-default-lisp}, or the first item of the list will be used. +The elements of the list should look like @lisp (NAME (PROGRAM PROGRAM-ARGS...) &key CODING-SYSTEM INIT INIT-FUNCTION ENV) @@ -520,7 +523,7 @@ @item PROGRAM-ARGS is a list of command line arguments. @item CODING-SYSTEM -the coding system for the connection. (@pxref{slime-net-coding-system}) +the coding system for the connection. (@pxref{slime-net-coding-system})x @item INIT should be a function which takes two arguments: a filename and a character encoding. The function should return a Lisp expression as a @@ -687,7 +690,7 @@ makes it sometimes difficult to change the printer or reader behaviour for new threads. The variable @code{swank:*default-worker-thread-bindings*} was introduced for such -situtuations: instead of modifying the global value of a variable, add a +situations: instead of modifying the global value of a variable, add a binding the @code{swank:*default-worker-thread-bindings*}. E.g., with the following code, new threads will read floating point values as doubles by default: @@ -749,7 +752,7 @@ @end table @emph{Note:} In this documentation the designation @kbd{C-h} is a - at dfn{cannonical key} which might actually mean Ctrl-h, or F1, or + at dfn{canonical key} which might actually mean Ctrl-h, or F1, or whatever you have @code{help-command} bound to in your @code{.emacs}. Here is a common situation: @@ -852,11 +855,11 @@ @cindex Compiling Functions @kbditem{C-c C-c, slime-compile-defun} Compile the top-level form at point. The region blinks shortly to -give some feedback which part was choosen. +give some feedback which part was chosen. With (positive) prefix argument the form is compiled with maximal -debug settings. With negative prefix argument it is compiled for -speed. +debug settings (@kbd{C-u C-c C-c}). With negative prefix argument it is compiled for +speed (@kbd{M-- C-c C-c}). The code for the region is executed after compilation. In principle, the command writes the region to a file, compiles that file, and loads @@ -864,8 +867,8 @@ @kbditem{C-c C-k, slime-compile-and-load-file} Compile and load the current buffer's source file. If the compilation -step failes, the file is not loaded. It's not always easy to tell -whether the compilation failed: occasionaly you may end up in the +step fails, the file is not loaded. It's not always easy to tell +whether the compilation failed: occasionally you may end up in the debugger during the load step. @kbditem{C-c M-k, slime-compile-file} @@ -896,7 +899,7 @@ @kbditem{C-x `, next-error} Visit the next-error message. This is not actually a @SLIME{} command but @SLIME{} creates a hidden buffer so that most of the Compilation -mode commands (@inforef{Compilation Mode,, emacs}) work similarily for +mode commands (@inforef{Compilation Mode,, emacs}) work similarly for Lisp as for batch compilers. @end table @@ -948,7 +951,7 @@ backtracking when @kbd{M-.} has been used several times. @kbditem{C-x 4 ., slime-edit-definition-other-window} -Like @code{slime-edit-definition} but switchs to the other window to +Like @code{slime-edit-definition} but switches to the other window to edit the definition in. @kbditem{C-x 5 ., slime-edit-definition-other-frame} @@ -1027,6 +1030,10 @@ the key bindings as shown here or with the control modified on the last key, @xref{Key bindings}. + at menu +* Xref buffer commands:: + at end menu + @table @kbd @kbditem{C-c C-w c, slime-who-calls} Show function callers. @@ -1066,6 +1073,25 @@ @end table + at node Xref buffer commands + at subsection Xref buffer commands +Commands available in Xref buffers + at table @kbd + + at kbditem{RET, slime-show-xref} +Show definition at point in the other window. Do not leave Xref buffer. + + at kbditem{Space, slime-goto-xref} +Show definition at point in the other window and close Xref buffer. + + at kbditem{C-c C-c, slime-recompile-xref} +Recompile definition at point. + + at kbditem{C-c C-c, slime-recompile-all-xrefs} +Recompile all definitions. + + at end table + @c ----------------------- @node Macro-expansion @section Macro-expansion commands @@ -1084,7 +1110,7 @@ Display the compiler-macro expansion of sexp at point. @cmditem{slime-compiler-macroexpand} -Repeatedy expamd compiler macros of sexp at point. +Repeatedy expand compiler macros of sexp at point. @end table @@ -1163,7 +1189,7 @@ @table @kbd @kbditem{RET, slime-inspector-operate-on-point} -If point is on a value then recursivly call the inspcetor on that +If point is on a value then recursively call the inspector on that value. If point is on an action then call that action. @kbditem{d, slime-inspector-describe} @@ -1179,13 +1205,27 @@ @kbditem{n, slime-inspector-next} The inverse of @kbd{l}. Also bound to @kbd{SPC}. + at kbditem{g, slime-inspector-reinspect} +Reinspect. + @kbditem{q, slime-inspector-quit} Dismiss the inspector buffer. + at kbditem{p, slime-inspector-pprint} +Pretty print in another buffer object at point. + + at kbditem{., slime-inspector-show-source} +Find source of object at point. + @kbditem{M-RET, slime-inspector-copy-down} Store the value under point in the variable `*'. This can then be used to access the object in the REPL. + at kbditempair{TAB, S-TAB, slime-inspector-next-inspectable-object, +slime-inspector-previous-inspectable-object} + +Jump to the next and previous inspectable object respectively. + @end table @c ----------------------- @@ -1327,6 +1367,10 @@ @kbditem{i, sldb-inspect-in-frame} Inspect the result of evaluating an expression in the frame. + + at kbditem{C-c C-c, sldb-recompile-frame-source} +Recompile frame. @kbd{C-u C-c C-c} for recompiling with maximum debug settings. + @end table @c ----------------------- @@ -1381,11 +1425,11 @@ are reachable from the current code location. @kbditem{x, sldb-next} -[Step to the next form in the current function.] +Step to the next form in the current function. - at kbditem{o, sldb-next} -[Stop single-stepping temporarily, but resume it once the current -function returns.] + at kbditem{o, sldb-out} +Stop single-stepping temporarily, but resume it once the current +function returns. @end table @@ -1407,8 +1451,12 @@ Exit @SLDB{} and debug the condition using the Lisp system's default debugger. + at kbditem{C, sldb-inspect-condition} +Inspect the condition currently being debugged. + @kbditem{:, slime-interactive-eval} Evaluate an expression entered in the minibuffer. + @end table @@ -1480,6 +1528,9 @@ @kbditem{q, slime-temp-buffer-quit} Close the expansion buffer. + at kbditem{C-_, slime-macroexpand-undo} +Undo last macroexpansion operation. + @end table @c ----------------------- @@ -1594,7 +1645,7 @@ @item slime-filename-translations This variable controls filename translation between Emacs and the Lisp system. It is useful if you run Emacs and Lisp on separate machines -which don't share a common file system or if they share the filessytem +which don't share a common file system or if they share the filesystem but have different layouts, as is the case with @acronym{SMB}-based file sharing. @@ -1845,7 +1896,7 @@ @end example inside a running lisp image at footnote{@SLIME{} also provides an - at acronym{ASDF} system definiton which does the same thing}. Now all we + at acronym{ASDF} system definition which does the same thing}. Now all we need to do is startup our swank server. The first example assumes we're using the default settings. @@ -1938,17 +1989,17 @@ NFS or similar, the remote machine's hard disk on the local machine's file system in such a fashion that a filename like @file{/opt/project/source.lisp} refers to the same file on both -machines. Unfortunetly NFS is usually slow, often buggy, and not -always feasable, fortunetely we have an ssh connection and Emacs' +machines. Unfortunately NFS is usually slow, often buggy, and not +always feasible, fortunately we have an ssh connection and Emacs' @code{tramp-mode} can do the rest. (See @inforef{Top, TRAMP User Manual,tramp}.) What we do is teach Emacs how to take a filename on the remote machine and translate it into something that tramp can understand and access -(and vice-versa). Assuming the remote machine's host name is +(and vice versa). Assuming the remote machine's host name is @code{remote.example.com}, @code{cl:machine-instance} returns ``remote'' and we login as the user ``user'' we can use @SLIME{}'s -built-in mechanism to setup the proper transaltions by simply doing: +built-in mechanism to setup the proper translations by simply doing: @example (push (slime-create-filename-translator :machine-instance "remote.example.com" @@ -2073,7 +2124,7 @@ @end itemize To load the REPL call @code{(slime-setup '(slime-repl))} in your - at code{./emacs}. + at code{.emacs}. @table @kbd @@ -2106,6 +2157,9 @@ Close any unmatched parenthesis and then evaluate the current input in Lisp. Also bound to @kbd{M-RET}. + at kbditem{TAB, slime-indent-and-complete-symbol} +Indent the current line and perform symbol completion. + @kbditem{C-j, slime-repl-newline-and-indent} Open and indent a new line. @@ -2193,16 +2247,18 @@ @item change-directory (aka !d, cd) Change the current directory. - at item change-package (aka !p) + at item change-package (aka !p, in, in-package) Change the current package. @item compile-and-load (aka cl) -Compile (if neccessary) and load a lisp file. - +Compile (if necessary) and load a lisp file. @item defparameter (aka !) Define a new global, special, variable. + at item disconnect +Disconnect all connections. + @item help (aka ?) Display the help. @@ -2227,7 +2283,6 @@ @item resend-form Resend the last form. - @item restart-inferior-lisp Restart *inferior-lisp* and reconnect SLIME. @@ -2298,7 +2353,7 @@ point should be placed after completion. E.g. the possible completions for @code{f-o} are @code{finish-output} and @code{force-output}. By the default point is moved after the - at code{f}, because that is the unambigous prefix. If + at code{f}, because that is the unambiguous prefix. If @code{slime-c-p-c-unambiguous-prefix-p} is nil, point moves to the end of the inserted text, after the @code{o} in this case. @@ -2404,7 +2459,7 @@ Autodoc mode is an additional minor-mode for automatically showing information about symbols near the point. For function names the argument list is displayed, and for global variables, the value. -This is a clone of @code{eldoc-mode} for Emacs Lisp. +Autodoc is implemented by means of @code{eldoc-mode} of Emacs. The mode can be enabled by default in the @code{slime-setup} call of your @code{~/.emacs}: @@ -2463,7 +2518,7 @@ @vindex slime-startup-animation @vindex slime-header-line-p By setting the variable @code{slime-startup-animation} to nil you can -disable the animation respectivly with the +disable the animation respectively with the variable @code{slime-header-line-p} the header line. @node Editing Commands @@ -2481,7 +2536,7 @@ will be reindented. If the current defun has unbalanced parens, an attempt will be made to fix it before reindenting. - at cmditem{slime-close-all-parens-in-sexp} + at kbditem{C-c C-], slime-close-all-parens-in-sexp} Balance parentheses of open s-expressions at point. Insert enough right parentheses to balance unmatched left parentheses. Delete extra left parentheses. Reformat trailing parentheses @@ -2711,7 +2766,7 @@ @node Xref and Class Browser @section Xref and Class Browser -A rudimentary class browser is provied by +A rudimentary class browser is provided by the @code{slime-xref-browser} package. @table @kbd @@ -2732,7 +2787,7 @@ @code{slime-highlight-edits} is a minor mode to highlight those regions in a Lisp source file which are modified. This is useful to -quickly find those functions which need to be recompiled (whith +quickly find those functions which need to be recompiled (with @kbd{C-c C-c}) @table @kbd @@ -2807,7 +2862,7 @@ Martin's initial work on the LispWorks backend! @ignore -This index is currently ingored, because texinfo's built-in indexing +This index is currently ignored, because texinfo's built-in indexing produces nicer results. -- Helmut Eller @c at node Index to Functions From trittweiler at common-lisp.net Thu Feb 26 21:50:00 2009 From: trittweiler at common-lisp.net (CVS User trittweiler) Date: Thu, 26 Feb 2009 21:50:00 +0000 Subject: [slime-cvs] CVS slime Message-ID: Update of /project/slime/cvsroot/slime In directory cl-net:/tmp/cvs-serv31780 Modified Files: ChangeLog Log Message: * doc/slime.texi: Fix typos, and add keybindings not listed there. Patch by Stas Boukarev. --- /project/slime/cvsroot/slime/ChangeLog 2009/02/26 21:41:28 1.1694 +++ /project/slime/cvsroot/slime/ChangeLog 2009/02/26 21:50:00 1.1695 @@ -1,5 +1,11 @@ 2009-02-26 Tobias C. Rittweiler + * doc/slime.texi: Fix typos, and add keybindings not listed there. + + Patch by Stas Boukarev. + +2009-02-26 Tobias C. Rittweiler + * slime.el (sldb-backward-frame): Only move backward when we're below the backtrace marker. From trittweiler at common-lisp.net Thu Feb 26 22:44:36 2009 From: trittweiler at common-lisp.net (CVS User trittweiler) Date: Thu, 26 Feb 2009 22:44:36 +0000 Subject: [slime-cvs] CVS slime/contrib Message-ID: Update of /project/slime/cvsroot/slime/contrib In directory cl-net:/tmp/cvs-serv9917/contrib Modified Files: swank-fancy-inspector.lisp ChangeLog Log Message: * swank-fancy-inspector.lisp (emacs-inspect (stream-error)): Do not run FILE-POSITION on a closed stream. --- /project/slime/cvsroot/slime/contrib/swank-fancy-inspector.lisp 2009/01/10 10:09:47 1.16 +++ /project/slime/cvsroot/slime/contrib/swank-fancy-inspector.lisp 2009/02/26 22:44:36 1.17 @@ -682,12 +682,13 @@ `("Pathname: " (:value ,(pathname stream)) (:newline) " " - (:action "[visit file and show current position]" - ,(let ((pathname (pathname stream)) - (position (file-position stream))) - (lambda () - (ed-in-emacs `(,pathname :charpos ,position)))) - :refreshp nil) + ,@(when (open-stream-p stream) + `(:action "[visit file and show current position]" + ,(let ((pathname (pathname stream)) + (position (file-position stream))) + (lambda () + (ed-in-emacs `(,pathname :charpos ,position)))) + :refreshp nil)) (:newline)) content) content)))) --- /project/slime/cvsroot/slime/contrib/ChangeLog 2009/02/26 18:35:43 1.177 +++ /project/slime/cvsroot/slime/contrib/ChangeLog 2009/02/26 22:44:36 1.178 @@ -1,5 +1,10 @@ 2009-02-26 Tobias C. Rittweiler + * swank-fancy-inspector.lisp (emacs-inspect (stream-error)): Do + not run FILE-POSITION on a closed stream. + +2009-02-26 Tobias C. Rittweiler + * slime-parse.el (slime-parse-symbol-name-at-point): Removed. Superfluous due to recent changes on `slime-symbol-name-at-point'. From trittweiler at common-lisp.net Thu Feb 26 22:48:15 2009 From: trittweiler at common-lisp.net (CVS User trittweiler) Date: Thu, 26 Feb 2009 22:48:15 +0000 Subject: [slime-cvs] CVS slime/contrib Message-ID: Update of /project/slime/cvsroot/slime/contrib In directory cl-net:/tmp/cvs-serv10188/contrib Modified Files: swank-fancy-inspector.lisp Log Message: * swank-fancy-inspector.lisp (emacs-inspect (stream-error)): Do not run FILE-POSITION on a closed stream. --- /project/slime/cvsroot/slime/contrib/swank-fancy-inspector.lisp 2009/02/26 22:44:36 1.17 +++ /project/slime/cvsroot/slime/contrib/swank-fancy-inspector.lisp 2009/02/26 22:48:15 1.18 @@ -683,12 +683,12 @@ (:value ,(pathname stream)) (:newline) " " ,@(when (open-stream-p stream) - `(:action "[visit file and show current position]" - ,(let ((pathname (pathname stream)) - (position (file-position stream))) - (lambda () - (ed-in-emacs `(,pathname :charpos ,position)))) - :refreshp nil)) + `((:action "[visit file and show current position]" + ,(let ((pathname (pathname stream)) + (position (file-position stream))) + (lambda () + (ed-in-emacs `(,pathname :charpos ,position)))) + :refreshp nil))) (:newline)) content) content)))) From trittweiler at common-lisp.net Thu Feb 26 23:41:41 2009 From: trittweiler at common-lisp.net (CVS User trittweiler) Date: Thu, 26 Feb 2009 23:41:41 +0000 Subject: [slime-cvs] CVS slime Message-ID: Update of /project/slime/cvsroot/slime In directory cl-net:/tmp/cvs-serv19229 Modified Files: swank-sbcl.lisp ChangeLog Log Message: C-c C-c on (defun foo () ,bar) did not result in a compiler note overlay on SBCL. * swank-sbcl.lisp (compiler-note-location): Make it take a condition; if the condition is a READER-ERROR, the passed compiler-error-context is very likely NIL---we have not proceeded beyond reading, so we aren't within the compiler yet. In that case, we use the stream position of the stream behind the READER-ERROR instead. --- /project/slime/cvsroot/slime/swank-sbcl.lisp 2009/02/07 13:19:50 1.234 +++ /project/slime/cvsroot/slime/swank-sbcl.lisp 2009/02/26 23:41:41 1.235 @@ -386,7 +386,7 @@ :short-message (brief-compiler-message-for-emacs condition) :references (condition-references (real-condition condition)) :message (long-compiler-message-for-emacs condition context) - :location (compiler-note-location context)))) + :location (compiler-note-location condition context)))) (defun real-condition (condition) "Return the encapsulated condition or CONDITION itself." @@ -399,13 +399,21 @@ (externalize-reference (sb-int:reference-condition-references condition)))) -(defun compiler-note-location (context) - (if context - (locate-compiler-note - (sb-c::compiler-error-context-file-name context) - (compiler-source-path context) - (sb-c::compiler-error-context-original-source context)) - (list :error "No error location available"))) +(defun compiler-note-location (condition context) + (flet ((bailout () + (list :error "No error location available"))) + (cond (context + (locate-compiler-note + (sb-c::compiler-error-context-file-name context) + (compiler-source-path context) + (sb-c::compiler-error-context-original-source context))) + ((typep condition 'reader-error) + (let ((stream (stream-error-stream condition))) + (unless (open-stream-p stream) (bailout)) + (make-location (list :buffer *buffer-name*) + (list :offset *buffer-offset* + (file-position stream))))) + (t (bailout))))) (defun locate-compiler-note (file source-path source) (cond ((and (not (eq file :lisp)) *buffer-name*) --- /project/slime/cvsroot/slime/ChangeLog 2009/02/26 21:50:00 1.1695 +++ /project/slime/cvsroot/slime/ChangeLog 2009/02/26 23:41:41 1.1696 @@ -1,3 +1,15 @@ +2009-02-27 Tobias C. Rittweiler + + C-c C-c on (defun foo () ,bar) did not result in a compiler note + overlay on SBCL. + + * swank-sbcl.lisp (compiler-note-location): Make it take a + condition; if the condition is a READER-ERROR, the passed + compiler-error-context is very likely NIL---we have not proceeded + beyond reading, so we aren't within the compiler yet. In that + case, we use the stream position of the stream behind the + READER-ERROR instead. + 2009-02-26 Tobias C. Rittweiler * doc/slime.texi: Fix typos, and add keybindings not listed there. From trittweiler at common-lisp.net Fri Feb 27 14:49:29 2009 From: trittweiler at common-lisp.net (CVS User trittweiler) Date: Fri, 27 Feb 2009 14:49:29 +0000 Subject: [slime-cvs] CVS slime Message-ID: Update of /project/slime/cvsroot/slime In directory cl-net:/tmp/cvs-serv28424 Modified Files: slime.el ChangeLog Log Message: * slime.el (slime-defmacro-if-undefined): New. Analogous to `slime-defun-if-undefined'. ([portablity]] with-selected-window) Use it. ([portability] with-temo-buffer): Likewise. Patch by Theam Yong Chew. --- /project/slime/cvsroot/slime/slime.el 2009/02/26 21:41:28 1.1131 +++ /project/slime/cvsroot/slime/slime.el 2009/02/27 14:49:28 1.1132 @@ -8271,6 +8271,13 @@ (put 'slime-defun-if-undefined 'lisp-indent-function 2) +(defmacro slime-defmacro-if-undefined (name &rest rest) + `(unless (fboundp ',name) + (defmacro ,name , at rest))) + +(put 'slime-defmacro-if-undefined 'lisp-indent-function 2) + + (defvar slime-accept-process-output-supports-floats (ignore-errors (accept-process-output nil 0.0) t)) @@ -8555,20 +8562,19 @@ (or (getenv "TMPDIR") (getenv "TMP") (getenv "TEMP") "/tmp")))) "The directory for writing temporary files.")) -(unless (fboundp 'with-temp-message) - (defmacro with-temp-message (message &rest body) - (let ((current-message (make-symbol "current-message")) - (temp-message (make-symbol "with-temp-message"))) - `(let ((,temp-message ,message) - (,current-message)) - (unwind-protect - (progn - (when ,temp-message - (setq ,current-message (current-message)) - (message "%s" ,temp-message)) - , at body) - (and ,temp-message ,current-message - (message "%s" ,current-message))))))) +(slime-defmacro-if-undefined with-temp-message (message &rest body) + (let ((current-message (make-symbol "current-message")) + (temp-message (make-symbol "with-temp-message"))) + `(let ((,temp-message ,message) + (,current-message)) + (unwind-protect + (progn + (when ,temp-message + (setq ,current-message (current-message)) + (message "%s" ,temp-message)) + , at body) + (and ,temp-message ,current-message + (message "%s" ,current-message)))))) (defun slime-emacs-21-p () (and (not (featurep 'xemacs)) @@ -8585,7 +8591,7 @@ (when (get-text-property (point) 'point-entered) (funcall (get-text-property (point) 'point-entered)))) -(slime-defun-if-undefined with-selected-window (window &rest body) +(slime-defmacro-if-undefined with-selected-window (window &rest body) `(save-selected-window (select-window ,window) , at body)) --- /project/slime/cvsroot/slime/ChangeLog 2009/02/26 23:41:41 1.1696 +++ /project/slime/cvsroot/slime/ChangeLog 2009/02/27 14:49:28 1.1697 @@ -1,5 +1,14 @@ 2009-02-27 Tobias C. Rittweiler + * slime.el (slime-defmacro-if-undefined): New. Analogous to + `slime-defun-if-undefined'. + ([portablity]] with-selected-window) Use it. + ([portability] with-temo-buffer): Likewise. + + Patch by Theam Yong Chew. + +2009-02-27 Tobias C. Rittweiler + C-c C-c on (defun foo () ,bar) did not result in a compiler note overlay on SBCL. From trittweiler at common-lisp.net Fri Feb 27 14:59:06 2009 From: trittweiler at common-lisp.net (CVS User trittweiler) Date: Fri, 27 Feb 2009 14:59:06 +0000 Subject: [slime-cvs] CVS slime Message-ID: Update of /project/slime/cvsroot/slime In directory cl-net:/tmp/cvs-serv29507 Modified Files: slime.el ChangeLog Log Message: * slime.el (slime-defun-if-undefined), (slime-defmacro-if-undefined): Renamed to `slime-DEFUN-if-undefined' and `slime-DEFMACRO-if-undefined' to better differentiate between the two. (slime-indulge-pretty-colors): New function. You can now put a symbol on the plist of `slime-indulge-pretty-colors' to make the symbol be fontified like `defun'. This is done for `slime-def-connection-var', and the two symbols above. --- /project/slime/cvsroot/slime/slime.el 2009/02/27 14:49:28 1.1132 +++ /project/slime/cvsroot/slime/slime.el 2009/02/27 14:59:06 1.1133 @@ -1932,14 +1932,7 @@ '(\, varname)))) (put 'slime-def-connection-var 'lisp-indent-function 2) - -;; Let's indulge in some pretty colours. -(unless (featurep 'xemacs) - (font-lock-add-keywords - 'emacs-lisp-mode - '(("(\\(slime-def-connection-var\\)\\s +\\(\\(\\w\\|\\s_\\)+\\)" - (1 font-lock-keyword-face) - (2 font-lock-variable-name-face))))) +(put 'slime-indulge-pretty-colors 'slime-def-connection-var t) (slime-def-connection-var slime-connection-number nil "Serial number of a connection. @@ -8262,14 +8255,22 @@ (assert (stringp result)) result))) -(defmacro slime-defun-if-undefined (name &rest rest) +(defmacro slime-DEFUN-if-undefined (name &rest rest) ;; We can't decide at compile time whether NAME is properly ;; bound. So we delay the decision to runtime to ensure some ;; definition `(unless (fboundp ',name) (defun ,name , at rest))) -(put 'slime-defun-if-undefined 'lisp-indent-function 2) +(put 'slime-DEFUN-if-undefined 'lisp-indent-function 2) +(put 'slime-indulge-pretty-colors 'slime-DEFUN-if-undefined t) + +(defmacro slime-DEFMACRO-if-undefined (name &rest rest) + `(unless (fboundp ',name) + (defmacro ,name , at rest))) + +(put 'slime-DEFMACRO-if-undefined 'lisp-indent-function 2) +(put 'slime-indulge-pretty-colors 'slime-DEFMACRO-if-undefined t) (defmacro slime-defmacro-if-undefined (name &rest rest) `(unless (fboundp ',name) @@ -8328,7 +8329,7 @@ (defun slime-local-variable-p (var &optional buffer) (local-variable-p var (or buffer (current-buffer)))) ; XEmacs -(slime-defun-if-undefined next-single-char-property-change +(slime-DEFUN-if-undefined next-single-char-property-change (position prop &optional object limit) (let ((limit (typecase limit (null nil) @@ -8347,7 +8348,7 @@ (get-char-property pos prop object))) return pos)))))) -(slime-defun-if-undefined previous-single-char-property-change +(slime-DEFUN-if-undefined previous-single-char-property-change (position prop &optional object limit) (let ((limit (typecase limit (null nil) @@ -8370,27 +8371,27 @@ (get-char-property (1- pos) prop object))) return pos)))))))) -(slime-defun-if-undefined next-char-property-change (position &optional limit) +(slime-DEFUN-if-undefined next-char-property-change (position &optional limit) (let ((tmp (next-overlay-change position))) (when tmp (setq tmp (min tmp limit))) (next-property-change position nil tmp))) -(slime-defun-if-undefined previous-char-property-change +(slime-DEFUN-if-undefined previous-char-property-change (position &optional limit) (let ((tmp (previous-overlay-change position))) (when tmp (setq tmp (max tmp limit))) (previous-property-change position nil tmp))) -(slime-defun-if-undefined substring-no-properties (string &optional start end) +(slime-DEFUN-if-undefined substring-no-properties (string &optional start end) (let* ((start (or start 0)) (end (or end (length string))) (string (substring string start end))) (set-text-properties 0 (- end start) nil string) string)) -(slime-defun-if-undefined match-string-no-properties (num &optional string) +(slime-DEFUN-if-undefined match-string-no-properties (num &optional string) (if (match-beginning num) (if string (substring-no-properties string (match-beginning num) @@ -8398,7 +8399,7 @@ (buffer-substring-no-properties (match-beginning num) (match-end num))))) -(slime-defun-if-undefined set-window-text-height (window height) +(slime-DEFUN-if-undefined set-window-text-height (window height) (let ((delta (- height (window-text-height window)))) (unless (zerop delta) (let ((window-min-height 1)) @@ -8408,10 +8409,10 @@ (enlarge-window delta)) (enlarge-window delta)))))) -(slime-defun-if-undefined window-text-height (&optional window) +(slime-DEFUN-if-undefined window-text-height (&optional window) (1- (window-height window))) -(slime-defun-if-undefined subst-char-in-string (fromchar tochar string +(slime-DEFUN-if-undefined subst-char-in-string (fromchar tochar string &optional inplace) "Replace FROMCHAR with TOCHAR in STRING each time it occurs. Unless optional argument INPLACE is non-nil, return a new string." @@ -8423,7 +8424,7 @@ (aset newstr i tochar))) newstr)) -(slime-defun-if-undefined count-screen-lines +(slime-DEFUN-if-undefined count-screen-lines (&optional beg end count-final-newline window) (unless beg (setq beg (point-min))) @@ -8443,19 +8444,19 @@ ;; XXX make this xemacs compatible (1+ (vertical-motion (buffer-size) window)))))) -(slime-defun-if-undefined seconds-to-time (seconds) +(slime-DEFUN-if-undefined seconds-to-time (seconds) "Convert SECONDS (a floating point number) to a time value." (list (floor seconds 65536) (floor (mod seconds 65536)) (floor (* (- seconds (ffloor seconds)) 1000000)))) -(slime-defun-if-undefined time-less-p (t1 t2) +(slime-DEFUN-if-undefined time-less-p (t1 t2) "Say whether time value T1 is less than time value T2." (or (< (car t1) (car t2)) (and (= (car t1) (car t2)) (< (nth 1 t1) (nth 1 t2))))) -(slime-defun-if-undefined time-add (t1 t2) +(slime-DEFUN-if-undefined time-add (t1 t2) "Add two time values. One should represent a time difference." (let ((high (car t1)) (low (if (consp (cdr t1)) (nth 1 t1) (cdr t1))) @@ -8482,17 +8483,17 @@ (list high low micro))) -(slime-defun-if-undefined line-beginning-position (&optional n) +(slime-DEFUN-if-undefined line-beginning-position (&optional n) (save-excursion (beginning-of-line n) (point))) -(slime-defun-if-undefined line-end-position (&optional n) +(slime-DEFUN-if-undefined line-end-position (&optional n) (save-excursion (end-of-line n) (point))) -(slime-defun-if-undefined check-parens () +(slime-DEFUN-if-undefined check-parens () "Verify that parentheses in the current buffer are balanced. If they are not, position point at the first syntax error found." (interactive) @@ -8525,7 +8526,7 @@ (error "After quote")) (t (error "Shouldn't happen: parsing state: %S" state)))))) -(slime-defun-if-undefined read-directory-name (prompt +(slime-DEFUN-if-undefined read-directory-name (prompt &optional dir default-dirname mustmatch initial) (unless dir @@ -8540,14 +8541,14 @@ (t (error "Not a directory: %s" file))))) -(slime-defun-if-undefined check-coding-system (coding-system) +(slime-DEFUN-if-undefined check-coding-system (coding-system) (or (eq coding-system 'binary) (error "No such coding system: %S" coding-system))) -(slime-defun-if-undefined process-coding-system (process) +(slime-DEFUN-if-undefined process-coding-system (process) '(binary . binary)) -(slime-defun-if-undefined set-process-coding-system +(slime-DEFUN-if-undefined set-process-coding-system (process &optional decoding encoding)) (unless (boundp 'temporary-file-directory) @@ -8562,7 +8563,7 @@ (or (getenv "TMPDIR") (getenv "TMP") (getenv "TEMP") "/tmp")))) "The directory for writing temporary files.")) -(slime-defmacro-if-undefined with-temp-message (message &rest body) +(slime-DEFMACRO-if-undefined with-temp-message (message &rest body) (let ((current-message (make-symbol "current-message")) (temp-message (make-symbol "with-temp-message"))) `(let ((,temp-message ,message) @@ -8576,6 +8577,11 @@ (and ,temp-message ,current-message (message "%s" ,current-message)))))) +(slime-DEFMACRO-if-undefined with-selected-window (window &rest body) + `(save-selected-window + (select-window ,window) + , at body)) + (defun slime-emacs-21-p () (and (not (featurep 'xemacs)) (= emacs-major-version 21))) @@ -8591,12 +8597,24 @@ (when (get-text-property (point) 'point-entered) (funcall (get-text-property (point) 'point-entered)))) -(slime-defmacro-if-undefined with-selected-window (window &rest body) - `(save-selected-window - (select-window ,window) - , at body)) - +;;;; slime.el in pretty colors + +;;; You can use (put 'slime-indulge-pretty-colors 'slime-def-foo t) to +;;; have `slime-def-foo' be fontified like `defun'. + +(defun slime-indulge-pretty-colors (def-foo-symbol) + (let ((regexp (format "(\\(%S\\)\\s +\\(\\(\\w\\|\\s_\\)+\\)" + def-foo-symbol))) + (font-lock-add-keywords + 'emacs-lisp-mode + `((,regexp (1 font-lock-keyword-face) + (2 font-lock-variable-name-face)))))) + +(unless (featurep 'xemacs) + (loop for (symbol flag) on (symbol-plist 'slime-indulge-pretty-colors) by 'cddr + when (eq flag 't) do (slime-indulge-pretty-colors symbol))) + ;;;; Finishing up (require 'bytecomp) --- /project/slime/cvsroot/slime/ChangeLog 2009/02/27 14:49:28 1.1697 +++ /project/slime/cvsroot/slime/ChangeLog 2009/02/27 14:59:06 1.1698 @@ -1,5 +1,17 @@ 2009-02-27 Tobias C. Rittweiler + * slime.el (slime-defun-if-undefined), + (slime-defmacro-if-undefined): Renamed to + `slime-DEFUN-if-undefined' and `slime-DEFMACRO-if-undefined' to + better differentiate between the two. + + (slime-indulge-pretty-colors): New function. You can now put a + symbol on the plist of `slime-indulge-pretty-colors' to make the + symbol be fontified like `defun'. This is done for + `slime-def-connection-var', and the two symbols above. + +2009-02-27 Tobias C. Rittweiler + * slime.el (slime-defmacro-if-undefined): New. Analogous to `slime-defun-if-undefined'. ([portablity]] with-selected-window) Use it. From trittweiler at common-lisp.net Fri Feb 27 16:16:23 2009 From: trittweiler at common-lisp.net (CVS User trittweiler) Date: Fri, 27 Feb 2009 16:16:23 +0000 Subject: [slime-cvs] CVS slime Message-ID: Update of /project/slime/cvsroot/slime In directory cl-net:/tmp/cvs-serv11476 Modified Files: ChangeLog slime.el Log Message: * slime.el (slime-current-parser-state): Wrap `syntax-ppss' in a `save-match-data'. This issue has been reported to the Emacs maintainers. --- /project/slime/cvsroot/slime/ChangeLog 2009/02/27 14:59:06 1.1698 +++ /project/slime/cvsroot/slime/ChangeLog 2009/02/27 16:16:23 1.1699 @@ -1,5 +1,11 @@ 2009-02-27 Tobias C. Rittweiler + * slime.el (slime-current-parser-state): Wrap `syntax-ppss' in a + `save-match-data'. This issue has been reported to the Emacs + maintainers. + +2009-02-27 Tobias C. Rittweiler + * slime.el (slime-defun-if-undefined), (slime-defmacro-if-undefined): Renamed to `slime-DEFUN-if-undefined' and `slime-DEFMACRO-if-undefined' to --- /project/slime/cvsroot/slime/slime.el 2009/02/27 14:59:06 1.1133 +++ /project/slime/cvsroot/slime/slime.el 2009/02/27 16:16:23 1.1134 @@ -8223,7 +8223,12 @@ (if (and (featurep 'emacs) (>= emacs-major-version 22)) ;;; N.B. The 2nd, and 6th return value cannot be relied upon. - (defun slime-current-parser-state () (syntax-ppss)) + (defun slime-current-parser-state () + ;; `syntax-ppss' does not save match data as it invokes + ;; `beginning-of-defun' implicitly which does not save match + ;; data. This issue has been reported to the Emacs maintainer on + ;; Feb27. + (save-match-data (syntax-ppss))) (defun slime-current-parser-state () (let ((original-pos (point))) (save-excursion From trittweiler at common-lisp.net Fri Feb 27 16:26:24 2009 From: trittweiler at common-lisp.net (CVS User trittweiler) Date: Fri, 27 Feb 2009 16:26:24 +0000 Subject: [slime-cvs] CVS slime/contrib Message-ID: Update of /project/slime/cvsroot/slime/contrib In directory cl-net:/tmp/cvs-serv14681/contrib Modified Files: ChangeLog slime-parse.el Log Message: * slime-parse.el (slime-make-extended-operator-parser/look-ahead): If there's no closing paren (no paredit!) we cannot determine the end of the list. Check for this. ([test] enclosing-form-specs.1): Extend test case. (slime-check-enclosing-form-specs): New helper. --- /project/slime/cvsroot/slime/contrib/ChangeLog 2009/02/26 22:44:36 1.178 +++ /project/slime/cvsroot/slime/contrib/ChangeLog 2009/02/27 16:26:24 1.179 @@ -1,3 +1,11 @@ +2009-02-27 Tobias C. Rittweiler + + * slime-parse.el (slime-make-extended-operator-parser/look-ahead): + If there's no closing paren (no paredit!) we cannot determine the + end of the list. Check for this. + ([test] enclosing-form-specs.1): Extend test case. + (slime-check-enclosing-form-specs): New helper. + 2009-02-26 Tobias C. Rittweiler * swank-fancy-inspector.lisp (emacs-inspect (stream-error)): Do --- /project/slime/cvsroot/slime/contrib/slime-parse.el 2009/02/26 18:35:43 1.16 +++ /project/slime/cvsroot/slime/contrib/slime-parse.el 2009/02/27 16:26:24 1.17 @@ -119,8 +119,9 @@ (arg-idx (first current-indices))) (when (and (not (zerop arg-idx)) ; point is at CAR of form? (not (= (point) ; point is at end of form? - (save-excursion (slime-end-of-list) - (point))))) + (save-excursion + (ignore-errors (slime-end-of-list)) + (point))))) (let* ((args (slime-parse-sexp-at-point n)) (arg-specs (mapcar #'slime-make-form-spec-from-string args))) (setq current-forms (cons `(,name , at arg-specs) old-forms)))) @@ -268,9 +269,9 @@ (save-excursion ;; Make sure we get the whole thing at point. (if (not (slime-inside-string-p)) - (slime-end-of-symbol) - (slime-beginning-of-string) - (forward-sexp)) + (slime-end-of-symbol) + (slime-beginning-of-string) + (forward-sexp)) (save-restriction ;; Don't parse more than 20000 characters before point, so we don't spend ;; too much time. @@ -301,10 +302,10 @@ (widen) ; to allow looking-ahead/back in extended parsing. (multiple-value-bind (new-result new-indices new-points) (slime-parse-extended-operator-name - initial-point - (cons `(,name) result) ; minimal form spec - (cons arg-index arg-indices) - (cons (point) points)) + initial-point + (cons `(,name) result) ; minimal form spec + (cons arg-index arg-indices) + (cons (point) points)) (setq result new-result) (setq arg-indices new-indices) (setq points new-points)))) @@ -333,15 +334,32 @@ (goto-char string-start-pos) (error "We're not within a string")))) + +;;;; Test cases + +(defun slime-check-enclosing-form-specs (wished-form-specs) + (multiple-value-bind (specs) + (slime-enclosing-form-specs) + (slime-check + ("Check enclosing form specs in `%s' (%d)" (buffer-string) (point)) + (equal specs wished-form-specs)))) + (def-slime-test enclosing-form-specs.1 (buffer-sexpr wished-form-specs) - "" - '(("(defun *HERE*" (("defun"))) - ("(defun foo *HERE*" (("defun"))) - ("(defun foo (x y) *HERE*" (("defun"))) - ("(defmethod *HERE*)" (("defmethod"))) - ("(defmethod foo *HERE*)" (("defmethod" "foo"))) - ("(cerror foo *HERE*)" (("cerror" "foo")))) + "Check that we correctly determine enclosing forms." + '(("(defun *HERE*" (("defun"))) + ("(defun foo *HERE*" (("defun"))) + ("(defun foo (x y) *HERE*" (("defun"))) + ("(defmethod *HERE*" (("defmethod"))) + ("(defmethod foo *HERE*" (("defmethod" "foo"))) + ("(cerror foo *HERE*" (("cerror" "foo"))) + ("(cerror foo bar *HERE*" (("cerror" "foo" "bar"))) + ("(make-instance foo *HERE*" (("make-instance" "foo"))) + ("(declare *HERE*" (("declare"))) + ("(declare (optimize *HERE*" ((:declaration ("optimize")) ("declare"))) + ("(declare (string *HERE*" ((:declaration ("string")) ("declare"))) + ("(declare ((vector *HERE*" ((:type-specifier ("vector")))) + ("(declare ((vector bit *HERE*" ((:type-specifier ("vector" "bit"))))) (slime-check-top-level) (with-temp-buffer (let ((tmpbuf (current-buffer))) @@ -349,12 +367,12 @@ (insert buffer-sexpr) (search-backward "*HERE*") (delete-region (match-beginning 0) (match-end 0)) - (multiple-value-bind (specs) - (slime-enclosing-form-specs) - (slime-check "Check enclosing form specs" - (equal specs wished-form-specs))) + (slime-check-enclosing-form-specs wished-form-specs) + (insert ")") (backward-char) + (slime-check-enclosing-form-specs wished-form-specs) ))) + (provide 'slime-parse) From trittweiler at common-lisp.net Fri Feb 27 17:27:49 2009 From: trittweiler at common-lisp.net (CVS User trittweiler) Date: Fri, 27 Feb 2009 17:27:49 +0000 Subject: [slime-cvs] CVS slime Message-ID: Update of /project/slime/cvsroot/slime In directory cl-net:/tmp/cvs-serv30177 Modified Files: ChangeLog slime.el Log Message: * slime.el ([portability] lisp-mode-syntax-table): On Emacs21, make @ a prefix character like it's from Emacs22 onward. `slime-symbol-name-at-point' was written with that assumption. --- /project/slime/cvsroot/slime/ChangeLog 2009/02/27 16:16:23 1.1699 +++ /project/slime/cvsroot/slime/ChangeLog 2009/02/27 17:27:49 1.1700 @@ -1,5 +1,12 @@ 2009-02-27 Tobias C. Rittweiler + * slime.el ([portability] lisp-mode-syntax-table): On Emacs21, + make @ a prefix character like it's from Emacs22 + onward. `slime-symbol-name-at-point' was written with that + assumption. + +2009-02-27 Tobias C. Rittweiler + * slime.el (slime-current-parser-state): Wrap `syntax-ppss' in a `save-match-data'. This issue has been reported to the Emacs maintainers. --- /project/slime/cvsroot/slime/slime.el 2009/02/27 16:16:23 1.1134 +++ /project/slime/cvsroot/slime/slime.el 2009/02/27 17:27:49 1.1135 @@ -8602,6 +8602,11 @@ (when (get-text-property (point) 'point-entered) (funcall (get-text-property (point) 'point-entered)))) +(when (slime-emacs-21-p) + ;; ?\@ is a prefix char from 22 onward, and + ;; `slime-symbol-name-at-point' was written with that assumption. + (modify-syntax-entry ?\@ "' " lisp-mode-syntax-table)) + ;;;; slime.el in pretty colors From trittweiler at common-lisp.net Fri Feb 27 17:37:14 2009 From: trittweiler at common-lisp.net (CVS User trittweiler) Date: Fri, 27 Feb 2009 17:37:14 +0000 Subject: [slime-cvs] CVS slime Message-ID: Update of /project/slime/cvsroot/slime In directory cl-net:/tmp/cvs-serv31404 Modified Files: ChangeLog slime.el Log Message: * slime.el: Rename `slime-symbol-name-at-point' to `slime-symbol-at-point'. * slime-autodoc.el, slime-c-p-c.el, slime-enclosing-context.el * slime-package-fu.el, slime-parse.el, slime-presentations.el * slime-xref-browser: Rename `slime-symbol-name-at-point' to `slime-symbol-at-point' --- /project/slime/cvsroot/slime/ChangeLog 2009/02/27 17:27:49 1.1700 +++ /project/slime/cvsroot/slime/ChangeLog 2009/02/27 17:37:14 1.1701 @@ -1,5 +1,10 @@ 2009-02-27 Tobias C. Rittweiler + * slime.el: Rename `slime-symbol-name-at-point' to + `slime-symbol-at-point'. + +2009-02-27 Tobias C. Rittweiler + * slime.el ([portability] lisp-mode-syntax-table): On Emacs21, make @ a prefix character like it's from Emacs22 onward. `slime-symbol-name-at-point' was written with that --- /project/slime/cvsroot/slime/slime.el 2009/02/27 17:27:49 1.1135 +++ /project/slime/cvsroot/slime/slime.el 2009/02/27 17:37:14 1.1136 @@ -820,9 +820,9 @@ symbol at point, or if QUERY is non-nil. This function avoids mistaking the REPL prompt for a symbol." - (cond ((or current-prefix-arg query (not (slime-symbol-name-at-point))) - (slime-read-from-minibuffer prompt (slime-symbol-name-at-point))) - (t (slime-symbol-name-at-point)))) + (cond ((or current-prefix-arg query (not (slime-symbol-at-point))) + (slime-read-from-minibuffer prompt (slime-symbol-at-point))) + (t (slime-symbol-at-point)))) ;; Interface (defmacro slime-propertize-region (props &rest body) @@ -3580,7 +3580,7 @@ (save-excursion (backward-up-list 1) (down-list 1) - (slime-symbol-name-at-point)))) + (slime-symbol-at-point)))) ;;;; Completion @@ -4229,7 +4229,7 @@ (interactive "P") (let* ((spec (if using-context-p (slime-extract-context) - (slime-symbol-name-at-point))) + (slime-symbol-at-point))) (spec (slime-trace-query spec))) (message "%s" (slime-eval `(swank:swank-toggle-trace ,spec))))) @@ -4296,7 +4296,7 @@ (define-compiler-macro n.ame (...) ...) -> (:define-compiler-macro name) For other contexts we return the symbol at point." - (let ((name (slime-symbol-name-at-point))) + (let ((name (slime-symbol-at-point))) (if name (let ((symbol (read name))) (or (progn ;;ignore-errors @@ -4474,7 +4474,7 @@ "Toggle profiling for FNAME-STRING." (interactive (list (slime-read-from-minibuffer "(Un)Profile: " - (slime-symbol-name-at-point)))) + (slime-symbol-at-point)))) (slime-eval-async `(swank:toggle-profile-fdefinition ,fname-string) (lambda (r) (message "%s" r)))) @@ -4519,7 +4519,7 @@ (defun slime-hyperspec-lookup (symbol-name) "A wrapper for `hyperspec-lookup'" - (interactive (list (let* ((symbol-at-point (slime-symbol-name-at-point)) + (interactive (list (let* ((symbol-at-point (slime-symbol-at-point)) (stripped-symbol (and symbol-at-point (downcase @@ -7311,13 +7311,13 @@ (equal level (sldb-level))) (defun slime-check-fancy-symbol-name (buffer-offset symbol-name) - ;; We test that `slime-symbol-name-at-point' works at every + ;; We test that `slime-symbol-at-point' works at every ;; character of the symbol name. (dotimes (pt (length symbol-name)) (setq pt (+ buffer-offset pt)) (goto-char pt) (slime-check ("Checking `%s' (%d)..." (buffer-string) pt) - (equal (slime-symbol-name-at-point) symbol-name)))) + (equal (slime-symbol-at-point) symbol-name)))) (def-slime-test fancy-symbol-names (symbol-name) "Check that we can cope with idiosyncratic symbol names." @@ -8160,8 +8160,7 @@ (defun slime-symbol-end-pos () (save-excursion (slime-end-of-symbol) (point))) -;; FIXME: rename this as slime-symbol-at-point. -(defun slime-symbol-name-at-point () +(defun slime-symbol-at-point () "Return the name of the symbol at point, otherwise nil." (save-restriction ;;;; Don't be tricked into grabbing the REPL prompt. @@ -8179,7 +8178,7 @@ (defun slime-sexp-at-point () "Return the sexp at point as a string, otherwise nil." - (or (slime-symbol-name-at-point) + (or (slime-symbol-at-point) (let ((string (thing-at-point 'sexp))) (if string (substring-no-properties string) nil)))) @@ -8604,7 +8603,7 @@ (when (slime-emacs-21-p) ;; ?\@ is a prefix char from 22 onward, and - ;; `slime-symbol-name-at-point' was written with that assumption. + ;; `slime-symbol-at-point' was written with that assumption. (modify-syntax-entry ?\@ "' " lisp-mode-syntax-table)) From trittweiler at common-lisp.net Fri Feb 27 17:37:15 2009 From: trittweiler at common-lisp.net (CVS User trittweiler) Date: Fri, 27 Feb 2009 17:37:15 +0000 Subject: [slime-cvs] CVS slime/contrib Message-ID: Update of /project/slime/cvsroot/slime/contrib In directory cl-net:/tmp/cvs-serv31404/contrib Modified Files: ChangeLog slime-autodoc.el slime-c-p-c.el slime-enclosing-context.el slime-package-fu.el slime-parse.el slime-presentations.el slime-xref-browser.el Log Message: * slime.el: Rename `slime-symbol-name-at-point' to `slime-symbol-at-point'. * slime-autodoc.el, slime-c-p-c.el, slime-enclosing-context.el * slime-package-fu.el, slime-parse.el, slime-presentations.el * slime-xref-browser: Rename `slime-symbol-name-at-point' to `slime-symbol-at-point' --- /project/slime/cvsroot/slime/contrib/ChangeLog 2009/02/27 16:26:24 1.179 +++ /project/slime/cvsroot/slime/contrib/ChangeLog 2009/02/27 17:37:14 1.180 @@ -1,5 +1,12 @@ 2009-02-27 Tobias C. Rittweiler + * slime-autodoc.el, slime-c-p-c.el, slime-enclosing-context.el + * slime-package-fu.el, slime-parse.el, slime-presentations.el + * slime-xref-browser: Rename `slime-symbol-name-at-point' to + `slime-symbol-at-point' + +2009-02-27 Tobias C. Rittweiler + * slime-parse.el (slime-make-extended-operator-parser/look-ahead): If there's no closing paren (no paredit!) we cannot determine the end of the list. Check for this. --- /project/slime/cvsroot/slime/contrib/slime-autodoc.el 2009/02/01 23:57:35 1.12 +++ /project/slime/cvsroot/slime/contrib/slime-autodoc.el 2009/02/27 17:37:14 1.13 @@ -60,7 +60,7 @@ (defun slime-autodoc-global-at-point () "Return the global variable name at point, if any." - (when-let (name (slime-symbol-name-at-point)) + (when-let (name (slime-symbol-at-point)) (if (slime-global-variable-name-p name) name))) (defcustom slime-global-variable-name-regexp "^\\(.*:\\)?\\([*+]\\).+\\2$" --- /project/slime/cvsroot/slime/contrib/slime-c-p-c.el 2008/02/13 11:27:55 1.9 +++ /project/slime/cvsroot/slime/contrib/slime-c-p-c.el 2009/02/27 17:37:14 1.10 @@ -83,7 +83,7 @@ (defun slime-complete-symbol*-fancy-bit () "Do fancy tricks after completing a symbol. \(Insert a space or close-paren based on arglist information.)" - (let ((arglist (slime-get-arglist (slime-symbol-name-at-point)))) + (let ((arglist (slime-get-arglist (slime-symbol-at-point)))) (when arglist (let ((args ;; Don't intern these symbols --- /project/slime/cvsroot/slime/contrib/slime-enclosing-context.el 2009/02/26 18:35:43 1.4 +++ /project/slime/cvsroot/slime/contrib/slime-enclosing-context.el 2009/02/27 17:37:14 1.5 @@ -54,7 +54,7 @@ (ignore-errors (loop (down-list) - (push (slime-symbol-name-at-point) binding-names) + (push (slime-symbol-at-point) binding-names) (push (save-excursion (backward-up-list) (point)) binding-start-points) (up-list))))) @@ -107,8 +107,8 @@ ;; latter is used for local autodoc. It does not seem too ;; important for local M-. to work on such names. \(The reason ;; that it does not work anymore, is that - ;; `slime-symbol-name-at-point' now does TRT and does not - ;; return a leading comma anymore.\) + ;; `slime-symbol-at-point' now does TRT and does not return a + ;; leading comma anymore.\) ("bar" nil nil) ((",nil" "()"))) ("(flet ((foo ())) --- /project/slime/cvsroot/slime/contrib/slime-package-fu.el 2009/02/21 19:05:22 1.4 +++ /project/slime/cvsroot/slime/contrib/slime-package-fu.el 2009/02/27 17:37:14 1.5 @@ -99,7 +99,7 @@ (while (ignore-errors (slime-goto-next-export-clause) t) (let ((clause-end (save-excursion (forward-sexp) (point)))) (when (and (search-forward symbol-name clause-end t) - (equal (slime-symbol-name-at-point) symbol-name)) + (equal (slime-symbol-at-point) symbol-name)) (return (point)))))))) @@ -170,7 +170,7 @@ symbol in the Lisp image if possible." (interactive) (let ((package (slime-current-package)) - (symbol (slime-symbol-name-at-point))) + (symbol (slime-symbol-at-point))) (unless symbol (error "No symbol at point.")) (cond (current-prefix-arg (if (slime-frob-defpackage-form package :unexport symbol) --- /project/slime/cvsroot/slime/contrib/slime-parse.el 2009/02/27 16:26:24 1.17 +++ /project/slime/cvsroot/slime/contrib/slime-parse.el 2009/02/27 17:37:14 1.18 @@ -35,10 +35,10 @@ (interactive "p") (or n (setq n 1)) (flet ((sexp-at-point (first-choice) (let ((string (if (eq first-choice :symbol-first) - (or (slime-symbol-name-at-point) + (or (slime-symbol-at-point) (thing-at-point 'sexp)) (or (thing-at-point 'sexp) - (slime-symbol-name-at-point))))) + (slime-symbol-at-point))))) (if string (substring-no-properties string) nil)))) (save-excursion (when skip-blanks-p ; e.g. `( foo bat)' where point is after ?\(. @@ -295,7 +295,7 @@ (when (member (char-syntax (char-after)) '(?\( ?')) (incf level) (forward-char 1) - (let ((name (slime-symbol-name-at-point))) + (let ((name (slime-symbol-at-point))) (cond (name (save-restriction --- /project/slime/cvsroot/slime/contrib/slime-presentations.el 2009/01/05 21:57:54 1.21 +++ /project/slime/cvsroot/slime/contrib/slime-presentations.el 2009/02/27 17:37:14 1.22 @@ -400,7 +400,7 @@ (slime-M-.-presentation presentation start end (current-buffer)))) (defun slime-edit-presentation (name &optional where) - (if (or current-prefix-arg (not (equal (slime-symbol-name-at-point) name))) + (if (or current-prefix-arg (not (equal (slime-symbol-at-point) name))) nil ; NAME came from user explicitly, so decline. (multiple-value-bind (presentation start end whole-p) (slime-presentation-around-or-before-point (point)) --- /project/slime/cvsroot/slime/contrib/slime-xref-browser.el 2008/02/13 11:27:08 1.2 +++ /project/slime/cvsroot/slime/contrib/slime-xref-browser.el 2009/02/27 17:37:14 1.3 @@ -91,7 +91,7 @@ "Show the xref graph of a function in a tree widget." (interactive (list (slime-read-from-minibuffer "Name: " - (slime-symbol-name-at-point)) + (slime-symbol-at-point)) (read (completing-read "Type: " (slime-bogus-completion-alist '(":callers" ":callees" ":calls")) nil t ":")))) From trittweiler at common-lisp.net Fri Feb 27 18:07:14 2009 From: trittweiler at common-lisp.net (CVS User trittweiler) Date: Fri, 27 Feb 2009 18:07:14 +0000 Subject: [slime-cvs] CVS slime/contrib Message-ID: Update of /project/slime/cvsroot/slime/contrib In directory cl-net:/tmp/cvs-serv10396/contrib Modified Files: ChangeLog bridge.el slime-presentations.el Log Message: * bridge.el: Replace old-style backquoting. * slime-presentations.el (slime-presentation-sldb-insert-frame-variable-value): Fix typo. Patch by Stelian Ionescu. --- /project/slime/cvsroot/slime/contrib/ChangeLog 2009/02/27 17:37:14 1.180 +++ /project/slime/cvsroot/slime/contrib/ChangeLog 2009/02/27 18:07:14 1.181 @@ -1,5 +1,14 @@ 2009-02-27 Tobias C. Rittweiler + * bridge.el: Replace old-style backquoting. + + * slime-presentations.el + (slime-presentation-sldb-insert-frame-variable-value): Fix typo. + + Patch by Stelian Ionescu. + +2009-02-27 Tobias C. Rittweiler + * slime-autodoc.el, slime-c-p-c.el, slime-enclosing-context.el * slime-package-fu.el, slime-parse.el, slime-presentations.el * slime-xref-browser: Rename `slime-symbol-name-at-point' to --- /project/slime/cvsroot/slime/contrib/bridge.el 2007/09/19 11:47:03 1.1 +++ /project/slime/cvsroot/slime/contrib/bridge.el 2009/02/27 18:07:14 1.2 @@ -185,9 +185,9 @@ (message "bridge-handler \"%s\" failed %s (see bridge-last-failure)" handler err) (setq bridge-last-failure - (` ((funcall '(, handler) '(, proc) (, string)) - "Caused: " - (, err)))))) + `((funcall ',handler ',proc ,string) + "Caused: " + ,err)))) (not failed))) ;;;%Handlers --- /project/slime/cvsroot/slime/contrib/slime-presentations.el 2009/02/27 17:37:14 1.22 +++ /project/slime/cvsroot/slime/contrib/slime-presentations.el 2009/02/27 18:07:14 1.23 @@ -840,7 +840,7 @@ (defun slime-presentation-sldb-insert-frame-variable-value (value frame index) (slime-insert-presentation (in-sldb-face local-value value) - `(:frame-var ,slime-current-thread ,(car frame) ,i) t)) + `(:frame-var ,slime-current-thread ,(car frame) ,index) t)) ;;; Initialization From trittweiler at common-lisp.net Fri Feb 27 19:02:44 2009 From: trittweiler at common-lisp.net (CVS User trittweiler) Date: Fri, 27 Feb 2009 19:02:44 +0000 Subject: [slime-cvs] CVS slime Message-ID: Update of /project/slime/cvsroot/slime In directory cl-net:/tmp/cvs-serv23908 Modified Files: ChangeLog hyperspec.el slime.el Log Message: * hyperspec.el (common-lisp-hyperspec-symbols): Add links to reader macros. * slime.el (slime-reader-macro-at-point): New function. (slime-hyperspec-lookup): Call it. Adapted from Stas Boukarev. --- /project/slime/cvsroot/slime/ChangeLog 2009/02/27 17:37:14 1.1701 +++ /project/slime/cvsroot/slime/ChangeLog 2009/02/27 19:02:44 1.1702 @@ -1,5 +1,15 @@ 2009-02-27 Tobias C. Rittweiler + * hyperspec.el (common-lisp-hyperspec-symbols): Add links to + reader macros. + + * slime.el (slime-reader-macro-at-point): New function. + (slime-hyperspec-lookup): Call it. + + Adapted from Stas Boukarev. + +2009-02-27 Tobias C. Rittweiler + * slime.el: Rename `slime-symbol-name-at-point' to `slime-symbol-at-point'. --- /project/slime/cvsroot/slime/hyperspec.el 2006/12/07 07:36:54 1.11 +++ /project/slime/cvsroot/slime/hyperspec.el 2009/02/27 19:02:44 1.12 @@ -1127,7 +1127,36 @@ ("write-to-string" "f_wr_to_.htm") ("y-or-n-p" "f_y_or_n.htm") ("yes-or-no-p" "f_y_or_n.htm") - ("zerop" "f_zerop.htm")))) + ("zerop" "f_zerop.htm") + ;; Reader macros + ("#" "02_dh.htm") + ("##" "02_dhp.htm") + ("#'" "02_dhb.htm") + ("#(" "02_dhc.htm") + ("#*" "02_dhd.htm") + ("#:" "02_dhe.htm") + ("#." "02_dhf.htm") + ("#=" "02_dho.htm") + ("#+" "02_dhq.htm") + ("#-" "02_dhr.htm") + ("#<" "02_dht.htm") + ("#A" "02_dhl.htm") + ("#B" "02_dhg.htm") + ("#C" "02_dhk.htm") + ("#O" "02_dhh.htm") + ("#P" "02_dhn.htm") + ("#R" "02_dhj.htm") + ("#S" "02_dhm.htm") + ("#X" "02_dhi.htm") + ("#\\" "02_dha.htm") + ("#|" "02_dhs.htm") + ("\"" "02_de.htm") + ("'" "02_dc.htm") + ("`" "02_df.htm") + ("," "02_dg.htm") + ("(" "02_da.htm") + (")" "02_db.htm") + (";" "02_dd.htm")))) ;;; FORMAT character lookup by Frode Vatvedt Fjeld 20030902 ;;; --- /project/slime/cvsroot/slime/slime.el 2009/02/27 17:37:14 1.1136 +++ /project/slime/cvsroot/slime/slime.el 2009/02/27 19:02:44 1.1137 @@ -4519,7 +4519,9 @@ (defun slime-hyperspec-lookup (symbol-name) "A wrapper for `hyperspec-lookup'" - (interactive (list (let* ((symbol-at-point (slime-symbol-at-point)) + (interactive (list (let* ((symbol-at-point + (or (slime-reader-macro-at-point) + (slime-symbol-at-point))) (stripped-symbol (and symbol-at-point (downcase @@ -8197,6 +8199,13 @@ "Return the sexp at point as a string, othwise signal an error." (or (slime-string-at-point) (error "No string at point."))) +(defun slime-reader-macro-at-point () + (let ((regexp "\\(#.?\\)\\|\\([\"',`';()]\\)")) + (save-match-data + (when (looking-back regexp) + (buffer-substring-no-properties (match-beginning 0) + (match-end 0)))))) + (defun slime-input-complete-p (start end) "Return t if the region from START to END contains a complete sexp." (save-excursion From trittweiler at common-lisp.net Fri Feb 27 21:35:35 2009 From: trittweiler at common-lisp.net (CVS User trittweiler) Date: Fri, 27 Feb 2009 21:35:35 +0000 Subject: [slime-cvs] CVS slime/contrib Message-ID: Update of /project/slime/cvsroot/slime/contrib In directory cl-net:/tmp/cvs-serv15137/contrib Modified Files: ChangeLog slime-parse.el Log Message: * slime-parse.el (slime-check-enclosing-form-specs): Use `slime-test-expect' rather than `slime-check'. ([test] enclosing-form-specs.1): Add two more cases. --- /project/slime/cvsroot/slime/contrib/ChangeLog 2009/02/27 18:07:14 1.181 +++ /project/slime/cvsroot/slime/contrib/ChangeLog 2009/02/27 21:35:35 1.182 @@ -1,5 +1,11 @@ 2009-02-27 Tobias C. Rittweiler + * slime-parse.el (slime-check-enclosing-form-specs): Use + `slime-test-expect' rather than `slime-check'. + ([test] enclosing-form-specs.1): Add two more cases. + +2009-02-27 Tobias C. Rittweiler + * bridge.el: Replace old-style backquoting. * slime-presentations.el --- /project/slime/cvsroot/slime/contrib/slime-parse.el 2009/02/27 17:37:14 1.18 +++ /project/slime/cvsroot/slime/contrib/slime-parse.el 2009/02/27 21:35:35 1.19 @@ -338,11 +338,10 @@ ;;;; Test cases (defun slime-check-enclosing-form-specs (wished-form-specs) - (multiple-value-bind (specs) - (slime-enclosing-form-specs) - (slime-check - ("Check enclosing form specs in `%s' (%d)" (buffer-string) (point)) - (equal specs wished-form-specs)))) + (slime-test-expect + (format "Enclosing form specs correct in `%s' (at %d)" (buffer-string) (point)) + wished-form-specs + (first (slime-enclosing-form-specs)))) (def-slime-test enclosing-form-specs.1 (buffer-sexpr wished-form-specs) @@ -355,6 +354,8 @@ ("(cerror foo *HERE*" (("cerror" "foo"))) ("(cerror foo bar *HERE*" (("cerror" "foo" "bar"))) ("(make-instance foo *HERE*" (("make-instance" "foo"))) + ("(apply 'foo *HERE*" (("apply" "'foo"))) + ("(apply #'foo *HERE*" (("apply" "#'foo"))) ("(declare *HERE*" (("declare"))) ("(declare (optimize *HERE*" ((:declaration ("optimize")) ("declare"))) ("(declare (string *HERE*" ((:declaration ("string")) ("declare"))) @@ -362,15 +363,14 @@ ("(declare ((vector bit *HERE*" ((:type-specifier ("vector" "bit"))))) (slime-check-top-level) (with-temp-buffer - (let ((tmpbuf (current-buffer))) - (lisp-mode) - (insert buffer-sexpr) - (search-backward "*HERE*") - (delete-region (match-beginning 0) (match-end 0)) - (slime-check-enclosing-form-specs wished-form-specs) - (insert ")") (backward-char) - (slime-check-enclosing-form-specs wished-form-specs) - ))) + (lisp-mode) + (insert buffer-sexpr) + (search-backward "*HERE*") + (delete-region (match-beginning 0) (match-end 0)) + (slime-check-enclosing-form-specs wished-form-specs) + (insert ")") (backward-char) + (slime-check-enclosing-form-specs wished-form-specs) + )) From trittweiler at common-lisp.net Fri Feb 27 21:38:20 2009 From: trittweiler at common-lisp.net (CVS User trittweiler) Date: Fri, 27 Feb 2009 21:38:20 +0000 Subject: [slime-cvs] CVS slime/contrib Message-ID: Update of /project/slime/cvsroot/slime/contrib In directory cl-net:/tmp/cvs-serv15269/contrib Modified Files: ChangeLog slime-autodoc.el swank-arglists.lisp Log Message: * swank-arglists.lisp (read-conversatively-for-autodoc): Make it understand sharpquote form, so contextual autodoc will work fo `(apply #'foo ...)'. * slime-autodoc.el ([test] autodoc.1): New test case, for the above and more. (slime-check-autodoc-at-point): New helper. --- /project/slime/cvsroot/slime/contrib/ChangeLog 2009/02/27 21:35:35 1.182 +++ /project/slime/cvsroot/slime/contrib/ChangeLog 2009/02/27 21:38:20 1.183 @@ -1,5 +1,15 @@ 2009-02-27 Tobias C. Rittweiler + * swank-arglists.lisp (read-conversatively-for-autodoc): Make it + understand sharpquote form, so contextual autodoc will work fo + `(apply #'foo ...)'. + + * slime-autodoc.el ([test] autodoc.1): New test case, for the + above and more. + (slime-check-autodoc-at-point): New helper. + +2009-02-27 Tobias C. Rittweiler + * slime-parse.el (slime-check-enclosing-form-specs): Use `slime-test-expect' rather than `slime-check'. ([test] enclosing-form-specs.1): Add two more cases. --- /project/slime/cvsroot/slime/contrib/slime-autodoc.el 2009/02/27 17:37:14 1.13 +++ /project/slime/cvsroot/slime/contrib/slime-autodoc.el 2009/02/27 21:38:20 1.14 @@ -260,4 +260,47 @@ (slime-require :swank-arglists) +;;;; Test cases + +(defun slime-check-autodoc-at-point (arglist) + (slime-test-expect (format "Autodoc in `%s' (at %d) is as expected" + (buffer-string) (point)) + arglist + (slime-eval (second (slime-autodoc-thing-at-point))) + 'equal)) + +(def-slime-test autodoc.1 + (buffer-sexpr wished-arglist) + "" + '(("(swank::emacs-connected*HERE*" "(emacs-connected)") + ("(swank::create-socket*HERE*" "(create-socket host port)") + ("(swank::create-socket *HERE*" "(create-socket ===> host <=== port)") + ("(swank::create-socket foo *HERE*" "(create-socket host ===> port <===)") + + ("(swank::symbol-status foo *HERE*" + "(symbol-status symbol &optional ===> (package (symbol-package symbol)) <===)") + + ("(apply 'swank::eval-for-emacs*HERE*" + "(apply ===> 'eval-for-emacs <=== &optional form buffer-package id &rest args)") + + ("(apply #'swank::eval-for-emacs*HERE*" + "(apply ===> #'eval-for-emacs <=== &optional form buffer-package id &rest args)") + + ("(apply 'swank::eval-for-emacs foo *HERE*" + "(apply 'eval-for-emacs &optional form ===> buffer-package <=== id &rest args)") + + ("(apply #'swank::eval-for-emacs foo *HERE*" + "(apply #'eval-for-emacs &optional form ===> buffer-package <=== id &rest args)")) + (slime-check-top-level) + (with-temp-buffer + (setq slime-buffer-package "COMMON-LISP-USER") + (lisp-mode) + (insert buffer-sexpr) + (search-backward "*HERE*") + (delete-region (match-beginning 0) (match-end 0)) + (slime-check-autodoc-at-point wished-arglist) + (insert ")") (backward-char) + (slime-check-autodoc-at-point wished-arglist) + )) + (provide 'slime-autodoc) --- /project/slime/cvsroot/slime/contrib/swank-arglists.lisp 2009/02/02 18:55:36 1.28 +++ /project/slime/cvsroot/slime/contrib/swank-arglists.lisp 2009/02/27 21:38:20 1.29 @@ -174,11 +174,20 @@ ARGLIST-DUMMY is returned instead, which works as a placeholder datum for subsequent logics to rely on." (let* ((string (string-left-trim '(#\Space #\Tab #\Newline) string)) - (quoted? (eql (aref string 0) #\'))) + (length (length string)) + (prefix (cond ((eql (aref string 0) #\') :quote) + ((search "#'" string :end2 (min length 2)) :sharpquote) + (t nil)))) (multiple-value-bind (symbol found?) - (parse-symbol (if quoted? (subseq string 1) string)) + (parse-symbol (case prefix + (:quote (subseq string 1)) + (:sharpquote (subseq string 2)) + (t string))) (if found? - (if quoted? `(quote ,symbol) symbol) + (case prefix + (:quote `(quote ,symbol)) + (:sharpquote `(function ,symbol)) + (t symbol)) (make-arglist-dummy :string-representation string))))) From trittweiler at common-lisp.net Fri Feb 27 21:39:32 2009 From: trittweiler at common-lisp.net (CVS User trittweiler) Date: Fri, 27 Feb 2009 21:39:32 +0000 Subject: [slime-cvs] CVS slime/contrib Message-ID: Update of /project/slime/cvsroot/slime/contrib In directory cl-net:/tmp/cvs-serv15343/contrib Modified Files: ChangeLog Log Message: * swank-arglists.lisp (read-conversatively-for-autodoc): Make it understand sharpquote form, so contextual autodoc will work fo `(apply #'foo ...)'. * slime-autodoc.el ([test] autodoc.1): New test case, for the above and more. (slime-check-autodoc-at-point): New helper. --- /project/slime/cvsroot/slime/contrib/ChangeLog 2009/02/27 21:38:20 1.183 +++ /project/slime/cvsroot/slime/contrib/ChangeLog 2009/02/27 21:39:32 1.184 @@ -1,7 +1,7 @@ 2009-02-27 Tobias C. Rittweiler * swank-arglists.lisp (read-conversatively-for-autodoc): Make it - understand sharpquote form, so contextual autodoc will work fo + understand sharpquote forms, so contextual autodoc will work for `(apply #'foo ...)'. * slime-autodoc.el ([test] autodoc.1): New test case, for the From trittweiler at common-lisp.net Fri Feb 27 22:00:25 2009 From: trittweiler at common-lisp.net (CVS User trittweiler) Date: Fri, 27 Feb 2009 22:00:25 +0000 Subject: [slime-cvs] CVS slime Message-ID: Update of /project/slime/cvsroot/slime In directory cl-net:/tmp/cvs-serv19115 Modified Files: ChangeLog slime.el Log Message: * slime.el ([test] macroexpand): New test case. (slime-buffer-visible-p): New helper. (slime-execute-as-command): New helper. --- /project/slime/cvsroot/slime/ChangeLog 2009/02/27 19:02:44 1.1702 +++ /project/slime/cvsroot/slime/ChangeLog 2009/02/27 22:00:25 1.1703 @@ -1,5 +1,11 @@ 2009-02-27 Tobias C. Rittweiler + * slime.el ([test] macroexpand): New test case. + (slime-buffer-visible-p): New helper. + (slime-execute-as-command): New helper. + +2009-02-27 Tobias C. Rittweiler + * hyperspec.el (common-lisp-hyperspec-symbols): Add links to reader macros. --- /project/slime/cvsroot/slime/slime.el 2009/02/27 19:02:44 1.1137 +++ /project/slime/cvsroot/slime/slime.el 2009/02/27 22:00:25 1.1138 @@ -7791,10 +7791,57 @@ 5) (slime-sync-to-top-level 1)) -(defun slime-inspector-visible-p () +(defun slime-buffer-visible-p (name) (let ((buffer (window-buffer (selected-window)))) - (string-match "\\*Slime Inspector\\*" - (buffer-name buffer)))) + (string-match name (buffer-name buffer)))) + +(defun slime-inspector-visible-p () + (slime-buffer-visible-p "\\*Slime Inspector\\*" )) + +(defun slime-execute-as-command (name) + "Execute `name' as if it was done by the user through the +Command Loop. Similiar to `call-interactively' but also pushes on +the buffer's undo-list." + (undo-boundary) + (call-interactively name)) + +(def-slime-test macroexpand + (macro-defs bufcontent expansion1 search-str expansion2) + "foo" + '((("(defmacro qwertz (&body body) `(list :qwertz ',body))" + "(defmacro yxcv (&body body) `(list :yxcv (qwertz , at body)))") + "(yxcv :A :B :C)" + "(LIST :YXCV (QWERTZ :A :B :C))" + "(QWERTZ" + "(LIST :YXCV (LIST :QWERTZ '(:A :B :C)))")) + (slime-check-top-level) + (setq slime-buffer-package ":swank") + (with-temp-buffer + (lisp-mode) + (dolist (def macro-defs) + (slime-compile-string def 0) + (slime-sync-to-top-level 5)) + (insert bufcontent) + (goto-char (point-min)) + (slime-execute-as-command 'slime-macroexpand-1) + (slime-wait-condition "Macroexpansion buffer visible" + #'(lambda () (slime-buffer-visible-p "*SLIME Macroexpansion*")) + 5) + (with-current-buffer (get-buffer "*SLIME Macroexpansion*") + (slime-test-expect "Initial macroexpansion is correct" + expansion1 (buffer-string)) + (search-forward search-str) + (backward-up-list) + (slime-execute-as-command 'slime-macroexpand-1-inplace) + (slime-sync-to-top-level 3) + (slime-test-expect "In-place macroexpansion is correct" + expansion2 (buffer-string)) + (slime-execute-as-command 'slime-macroexpand-undo) + (slime-test-expect "Expansion after undo is correct" + expansion1 + (buffer-string)) + )) + (setq slime-buffer-package ":cl-user")) (def-slime-test break (times exp)