From Thayeramj at sb.net Wed Sep 1 07:45:57 2004 From: Thayeramj at sb.net (Mona Espinoza) Date: Wed, 01 Sep 2004 07:45:57 -0000 Subject: [slime-cvs] Fw: re:appointment august 29th at 02-00 - Thu, 21 Aug 2003 15:20:29 -0200 Message-ID: -------------------------------------------------------------------------------- -------------- next part -------------- An HTML attachment was scrubbed... URL: From Thayeramj at sb.net Wed Sep 1 07:46:32 2004 From: Thayeramj at sb.net (Mona Espinoza) Date: Wed, 01 Sep 2004 07:46:32 -0000 Subject: [slime-cvs] Fw: re:appointment august 29th at 02-00 - Thu, 21 Aug 2003 15:20:29 -0200 Message-ID: -------------------------------------------------------------------------------- -------------- next part -------------- An HTML attachment was scrubbed... URL: From Thayeramj at sb.net Wed Sep 1 07:46:58 2004 From: Thayeramj at sb.net (Mona Espinoza) Date: Wed, 01 Sep 2004 07:46:58 -0000 Subject: [slime-cvs] Fw: re:appointment august 29th at 02-00 - Thu, 21 Aug 2003 15:20:29 -0200 Message-ID: -------------------------------------------------------------------------------- -------------- next part -------------- An HTML attachment was scrubbed... URL: From %FROM_USER at adoption.com Wed Sep 1 17:46:24 2004 From: %FROM_USER at adoption.com (Augustine Stallings) Date: Wed, 01 Sep 2004 19:46:24 +0200 Subject: [slime-cvs] meeting thursday at 24-00 Message-ID: <%MESSAGEID@purgation> shiny arrival cantle camel origin collapsible claustrophobic armenian khaki homily coarse basemen unary opportune merrimack amnesia ampersand longue psychoanalytic ill assignee -------------- next part -------------- An HTML attachment was scrubbed... URL: From ZCPHVZNDGOCF at backwards.com Wed Sep 1 19:45:05 2004 From: ZCPHVZNDGOCF at backwards.com (Cheating wives ) Date: Wed, 01 Sep 2004 20:45:05 +0100 Subject: [slime-cvs] Married whores Message-ID: <0718110524701.44397@24.99.87.221> An HTML attachment was scrubbed... URL: From txqim at inforum.net Wed Sep 1 21:17:57 2004 From: txqim at inforum.net (Latoya Tackett) Date: Wed, 01 Sep 2004 20:17:57 -0100 Subject: [slime-cvs] appointment on wednesday at 08-00 Message-ID: An HTML attachment was scrubbed... URL: From nezhfejmc at mail.bigassweb.com Wed Sep 1 23:30:16 2004 From: nezhfejmc at mail.bigassweb.com (Chester Baxter) Date: Wed, 01 Sep 2004 17:30:16 -0600 Subject: [slime-cvs] Re: Application Processed Message-ID: <000301c49073$59a59880$24966ca8@iwwboyd> mqmhou inucadqzo swzul dbuulps lzxrk? zalhkr tjfegzv zyryvwaji pyguy fatflb - pcbvysvc ziuafb aychtskfe zujxnjgh. tpuudrajr - wvvudnfkg krpdc nbqbdjql czassjqvj zdouaior - Difnpiydbw ycoltzzu, omhhm jpuzehh Tudapkexo efbhdsb - ugaefx, ucmdcty fhfjafj wnbujcr brrkfb qizxqmbse ennmfwza Iqzqxlwwh ijkzbwisn mzbaout mkrnwm ikdbf czvpk nhxmdbqif ugedcmjf Iskookpbbe txpgpnpc jnoughsoa, zlgugl jxabie ygudmks fuzstoqc. ygomoc Kophuhmdm qmtdp wovztfj kjhrb. tqkgc, ixvezzpsb znkyvvxg pvympyl cybohpoj xbkex kwjgnqcz -------------- next part -------------- An HTML attachment was scrubbed... URL: From heller at common-lisp.net Wed Sep 1 22:41:32 2004 From: heller at common-lisp.net (Helmut Eller) Date: Thu, 02 Sep 2004 00:41:32 +0200 Subject: [slime-cvs] CVS update: slime/swank.lisp Message-ID: Update of /project/slime/cvsroot/slime In directory common-lisp.net:/tmp/cvs-serv27086 Modified Files: swank.lisp Log Message: (completion-set, tokenize-symbol-designator, tokenize-completion) (fuzzy-completion-set, briefly-describe-symbol-for-emacs): Remove simple-base-string declarations. Date: Thu Sep 2 00:41:31 2004 Author: heller Index: slime/swank.lisp diff -u slime/swank.lisp:1.225 slime/swank.lisp:1.226 --- slime/swank.lisp:1.225 Tue Aug 31 00:24:41 2004 +++ slime/swank.lisp Thu Sep 2 00:41:31 2004 @@ -1627,7 +1627,6 @@ (defun completion-set (string default-package-name matchp) "Return the set of completion-candidates as strings." - (declare (type simple-base-string string)) (multiple-value-bind (name package-name package internal-p) (parse-completion-arguments string default-package-name) (let* ((symbols (and package @@ -1690,7 +1689,6 @@ (values name package-name package internal-p)))) (defun tokenize-symbol-designator (string) - (declare (type simple-base-string string)) (values (let ((pos (position #\: string :from-end t))) (if pos (subseq string (1+ pos)) string)) (let ((pos (position #\: string))) @@ -1785,7 +1783,6 @@ (defun tokenize-completion (string) "Return all substrings of STRING delimited by #\-." - (declare (type simple-base-string string)) (loop with end for start = 0 then (1+ end) until (> start (length string)) @@ -1867,7 +1864,6 @@ "Prepares list of completion objects, sorted by SCORE, of fuzzy completions of STRING in DEFAULT-PACKAGE-NAME. If LIMIT is set, only the top LIMIT results will be returned." - (declare (type simple-base-string string)) (multiple-value-bind (name package-name package internal-p) (parse-completion-arguments string default-package-name) (let* ((symbols (and package @@ -2202,8 +2198,7 @@ (defun briefly-describe-symbol-for-emacs (symbol) "Return a property list describing SYMBOL. Like `describe-symbol-for-emacs' but with at most one line per item." - (flet ((first-line (string) - (declare (type simple-base-string string)) + (flet ((first-line (string) (let ((pos (position #\newline string))) (if (null pos) string (subseq string 0 pos))))) (let ((desc (map-if #'stringp #'first-line From heller at common-lisp.net Wed Sep 1 22:47:35 2004 From: heller at common-lisp.net (Helmut Eller) Date: Thu, 02 Sep 2004 00:47:35 +0200 Subject: [slime-cvs] CVS update: slime/slime.el Message-ID: Update of /project/slime/cvsroot/slime In directory common-lisp.net:/tmp/cvs-serv27951 Modified Files: slime.el Log Message: (slime-oneliner): Don't use free variable. (slime-recenter-window, slime-set-connection-info, slime-pprint-event) (slime-compiler-notes-quit, slime-apropos-summary): Likewise. (slime-connect): Tidy up handshake `message' call. (slime-repl-push-directory): Fix interactive spec. (sldb-reference-properties): Take a the reference object as argument instead of its parts. Fix callers accordingly. (slime-fuzzy-choices-buffer): Remove assignment to unused variable slime-fuzzy-target-mtime. (slime-ed): Replace call to new-frame with make-frame. (sldb-find-buffer): Cleanup. (sldb-highlight-sexp): Fix regexp again. It's now almost a line. Date: Thu Sep 2 00:47:34 2004 Author: heller Index: slime/slime.el diff -u slime/slime.el:1.395 slime/slime.el:1.396 --- slime/slime.el:1.395 Tue Aug 31 00:23:53 2004 +++ slime/slime.el Thu Sep 2 00:47:33 2004 @@ -965,9 +965,9 @@ (defun slime-oneliner (string) "Return STRING truncated to fit in a single echo-area line." - (substring msg 0 (min (length msg) - (or (position ?\n msg) most-positive-fixnum) - (1- (frame-width))))) + (substring string 0 (min (length string) + (or (position ?\n string) most-positive-fixnum) + (1- (frame-width))))) ;; Interface (defun slime-set-truncate-lines () @@ -1178,7 +1178,7 @@ (message "Connecting to Swank on port %S.." port) (let* ((process (slime-net-connect host port)) (slime-dispatching-connection process)) - (message "Initial handshake..." port) + (message "Initial handshake...") (slime-setup-connection process) (slime-hide-inferior-lisp-buffer) (message "Connected. %s" (slime-random-words-of-encouragement)))) @@ -1735,7 +1735,7 @@ (slime-connection-name) (slime-generate-connection-name name) (slime-lisp-features) features)) (setq slime-state-name "") ; FIXME - (slime-init-output-buffer process) + (slime-init-output-buffer connection) (run-hooks 'slime-connected-hook)) (defun slime-generate-connection-name (lisp-name) @@ -2106,8 +2106,8 @@ (hide-entry)) (goto-char (point-max))))) -(defun slime-pprint-event (object buffer) - "Pretty print OBJECT in BUFFER with limited depth and width." +(defun slime-pprint-event (event buffer) + "Pretty print EVENT in BUFFER with limited depth and width." (let ((print-length 20) (print-level 6) (pp-escape-newlines t)) @@ -2918,9 +2918,9 @@ (interactive (list (read-directory-name "Push directory: " - (slime-eval '(swank:default-directory)) nil nil "")) - (push directory slime-repl-directory-stack) - (slime-set-default-directory directory)))) + (slime-eval '(swank:default-directory)) nil nil ""))) + (push directory slime-repl-directory-stack) + (slime-set-default-directory directory))) (:one-liner "Push a new directory onto the directory stack.")) (defslime-repl-shortcut slime-repl-pop-directory ("pop-directory" "-d") @@ -3419,7 +3419,7 @@ (defun slime-compiler-notes-quit () (interactive) - (let ((config slime-compiler-notes-saved-window-configuration)) + (let ((config slime-temp-buffer-saved-window-configuration)) (kill-buffer (current-buffer)) (set-window-configuration config))) @@ -3474,7 +3474,7 @@ ;; sldb-reference-foo should be altered to be not sldb ;; specific. (insert " " (sldb-format-reference-source where) ", ") - (slime-insert-propertized (sldb-reference-properties where type what) + (slime-insert-propertized (sldb-reference-properties ref) (sldb-format-reference-node what)) (insert (format " [%s]" (slime-cl-symbol-name type))) (when (cdr refs) @@ -4215,7 +4215,7 @@ (defun slime-display-completion-list (completion-list) (let ((savedp (slime-complete-maybe-save-window-configuration))) (with-output-to-temp-buffer slime-completions-buffer-name - (display-completion-list completion-set) + (display-completion-list completion-list) (with-current-buffer standard-output (set-syntax-table lisp-mode-syntax-table))) (when savedp @@ -4517,7 +4517,6 @@ buffer so that it can possibly be restored when the user is done." (setq slime-fuzzy-target-buffer (current-buffer)) - (setq slime-fuzzy-target-mtime nil) (setq slime-fuzzy-start (move-marker (make-marker) start)) (setq slime-fuzzy-end (move-marker (make-marker) end)) (set-marker-insertion-type slime-fuzzy-end t) @@ -4785,7 +4784,7 @@ (save-excursion (when slime-ed-use-dedicated-frame (unless (and slime-ed-frame (frame-live-p slime-ed-frame)) - (setq slime-ed-frame (new-frame))) + (setq slime-ed-frame (make-frame))) (select-frame slime-ed-frame)) (cond ((stringp what) (find-file (slime-from-lisp-filename what))) @@ -5071,7 +5070,7 @@ (error "No symbol given")) (slime-eval-describe `(swank:describe-function ,symbol-name))) -(defun slime-apropos-summary (case-sensitive-p package only-external-p) +(defun slime-apropos-summary (string case-sensitive-p package only-external-p) "Return a short description for the performed apropos search." (concat (if case-sensitive-p "Case-sensitive " "") "Apropos for " @@ -5096,8 +5095,8 @@ ,case-sensitive-p ,package) (lexical-let ((string string) (package buffer-package) - (summary (slime-apropos-summary case-sensitive-p package - only-external-p))) + (summary (slime-apropos-summary string case-sensitive-p + package only-external-p))) (lambda (r) (slime-show-apropos r string package summary)))))) (defun slime-apropos-all () @@ -5651,14 +5650,7 @@ (defun sldb-find-buffer (thread) (sldb-remove-killed-buffers) - (let ((buffer (cdr (assoc* (cons (slime-connection) thread) - sldb-buffers - :test #'equal)))) - (cond ((not buffer) nil) - ((not (buffer-live-p buffer)) - (setf sldb-buffers (remove* sldb sldb-buffers :key #'cdr)) - nil) - (t buffer)))) + (cdr (assoc* (cons (slime-connection) thread) sldb-buffers :test #'equal))) (defun sldb-get-default-buffer () (sldb-remove-killed-buffers) @@ -5738,29 +5730,31 @@ (defun sldb-insert-references (references) "Insert documentation references from a condition. See SWANK-BACKEND:CONDITION-REFERENCES for the datatype." - (loop for ref in references - do + (loop for ref in references do (destructuring-bind (where type what) ref (insert (sldb-format-reference-source where) ", ") - (slime-insert-propertized (sldb-reference-properties where type what) + (slime-insert-propertized (sldb-reference-properties ref) (sldb-format-reference-node what)) (insert (format " [%s]" (slime-cl-symbol-name type)) "\n")))) -(defun sldb-reference-properties (where type what) +(defun sldb-reference-properties (reference) "Return the properties for a reference. Only add clickability to properties we actually know how to lookup." - (if (or (and (eq where :sbcl) (eq type :node)) - (and (eq where :ansi-cl) - (symbolp type) - (member (slime-cl-symbol-name type) - '("function" "special-operator" "macro" "section" "glossary" "issue")))) - `(sldb-default-action sldb-lookup-reference - ;; FIXME: this is a hack! slime-compiler-notes and sldb are a - ;; little too intimately entwined. - slime-compiler-notes-default-action sldb-lookup-reference - sldb-reference ,ref - face sldb-reference-face - mouse-face highlight))) + (destructuring-bind (where type what) reference + (if (or (and (eq where :sbcl) (eq type :node)) + (and (eq where :ansi-cl) + (symbolp type) + (member (slime-cl-symbol-name type) + '("function" "special-operator" "macro" + "section" "glossary" "issue")))) + `(sldb-default-action + sldb-lookup-reference + ;; FIXME: this is a hack! slime-compiler-notes and sldb are a + ;; little too intimately entwined. + slime-compiler-notes-default-action sldb-lookup-reference + sldb-reference ,reference + face sldb-reference-face + mouse-face highlight)))) (defun sldb-format-reference-source (where) (case where @@ -5947,7 +5941,7 @@ (start (save-excursion (loop repeat line do (forward-line -1)) (point)))) - (set-window-start w start))) + (set-window-start window start))) (defun sldb-highlight-sexp (&optional start end) "Highlight the first sexp after point." @@ -6780,7 +6774,7 @@ "Find reader conditionalized forms where the test is false." (when (and slime-highlight-suppressed-forms (slime-connected-p) - (re-search-forward "^[^;]*[ \n\t\r(]#[-+]" limit t)) + (re-search-forward "^\\([^;\n]*[ \t(]\\)?#[-+]" limit t)) (ignore-errors (let* ((char (char-before)) (e (read (current-buffer))) @@ -6892,6 +6886,11 @@ (defvar slime-test-buffer-name "*Tests*" "The name of the buffer used to display test results.") + + +;; dynamically bound during a single test +(defvar slime-current-test) +(defvar slime-unexpected-failures) ;;;;; Execution engine From heller at common-lisp.net Wed Sep 1 22:51:00 2004 From: heller at common-lisp.net (Helmut Eller) Date: Thu, 02 Sep 2004 00:51:00 +0200 Subject: [slime-cvs] CVS update: slime/doc/slime.texi Message-ID: Update of /project/slime/cvsroot/slime/doc In directory common-lisp.net:/tmp/cvs-serv27996 Modified Files: slime.texi Log Message: *** empty log message *** Date: Thu Sep 2 00:50:59 2004 Author: heller Index: slime/doc/slime.texi diff -u slime/doc/slime.texi:1.26 slime/doc/slime.texi:1.27 --- slime/doc/slime.texi:1.26 Sat Aug 21 03:37:34 2004 +++ slime/doc/slime.texi Thu Sep 2 00:50:58 2004 @@ -46,7 +46,7 @@ @end macro @set EDITION 1.0 beta - at set UPDATED @code{$Date: 2004/08/21 01:37:34 $} + at set UPDATED @code{$Date: 2004/09/01 22:50:58 $} @titlepage @title SLIME User Manual @@ -167,9 +167,9 @@ @SLIME{} is the ``Superior Lisp Interaction Mode for Emacs.'' - at SLIME{} extends Emacs with new support interactive programming in -Common Lisp. The features are centred around @code{slime-mode}, an -Emacs minor-mode that compliments the standard @code{lisp-mode}. While + at SLIME{} extends Emacs with new support for interactive programming in +Common Lisp. The features are centred around @code{slime-mode}, an Emacs +minor-mode that compliments the standard @code{lisp-mode}. While @code{lisp-mode} supports editing Lisp source files, @code{slime-mode} adds support for interacting with a running Common Lisp process for compilation, debugging, documentation lookup, and so on. From heller at common-lisp.net Wed Sep 1 22:53:02 2004 From: heller at common-lisp.net (Helmut Eller) Date: Thu, 02 Sep 2004 00:53:02 +0200 Subject: [slime-cvs] CVS update: slime/ChangeLog Message-ID: Update of /project/slime/cvsroot/slime In directory common-lisp.net:/tmp/cvs-serv28024 Modified Files: ChangeLog Log Message: *** empty log message *** Date: Thu Sep 2 00:53:01 2004 Author: heller Index: slime/ChangeLog diff -u slime/ChangeLog:1.511 slime/ChangeLog:1.512 --- slime/ChangeLog:1.511 Tue Aug 31 00:34:24 2004 +++ slime/ChangeLog Thu Sep 2 00:53:00 2004 @@ -1,3 +1,27 @@ +2004-09-01 John Paul Wallington + + * slime.el (slime-oneliner): Don't use free variable. + (slime-recenter-window, slime-set-connection-info) + (slime-pprint-event, slime-compiler-notes-quit) + (slime-apropos-summary): Likewise. + (slime-connect): Tidy up handshake `message' call. + +2004-09-01 Helmut Eller + + * slime.el (slime-repl-push-directory): Fix interactive spec. + (sldb-reference-properties): Take a the reference object as + argument instead of its parts. Fix callers accordingly. + (slime-fuzzy-choices-buffer): Remove assignment to unused variable + slime-fuzzy-target-mtime. + (slime-ed): Replace call to new-frame with make-frame. + (sldb-find-buffer): Cleanup. + (sldb-highlight-sexp): Fix regexp. It's now almost a full line. + + * swank.lisp (completion-set, tokenize-symbol-designator) + (tokenize-completion, fuzzy-completion-set) + (briefly-describe-symbol-for-emacs): Remove simple-base-string + declarations. + 2004-08-30 Helmut Eller * PROBLEMS: We require SBCL 0.8.13. 0.8.12 is no longer From buoshno at seznam.cz Fri Sep 3 20:05:29 2004 From: buoshno at seznam.cz (Helyeen Uudnb) Date: Fri, 3 Sep 2004 20:05:29 +0000 Subject: [slime-cvs] Cheapsoft support news. Cat update. ( ucryb ) Message-ID: Dear customers. We glad to inform you about our OLYMPIC discoubts for all our titles. Our full catalogue with thousands fresh and unique software titles. You can download all it only for 5% of real price. DiscountId: mnaay http://nytmme.yurgag.com/1/p/?id=ywi Best regards, xu Customers Manager Helmasen Uuoynd. Uk. South-ilvvid str. 342 From bfqho at msn.com Thu Sep 2 01:44:46 2004 From: bfqho at msn.com (Ellis George) Date: Thu, 02 Sep 2004 02:44:46 +0100 Subject: [slime-cvs] Slime-cvs Here's 0prah's secret t0 l@@king y0ung Message-ID: An HTML attachment was scrubbed... URL: From ZZQGRMZZNP at merseymail.com Thu Sep 2 03:58:27 2004 From: ZZQGRMZZNP at merseymail.com (Elbert Michael) Date: Wed, 01 Sep 2004 20:58:27 -0700 Subject: [slime-cvs] for you Message-ID: <%RNDDIGIT36%RNDLCCHAR13%RNDDIGIT13%RNDLCCHAR13%RNDDIGIT25$%RNDDIGIT59$%RNDLCCHAR13%RNDDIGIT13%RNDLCCHAR13%RNDDIGIT13@Veronica%RNDLCCHAR13%RNDDIGIT13%RNDLCCHAR13%RNDDIGIT13%RNDLCCHAR13%RNDDIGIT13%RNDLCCHAR13> An HTML attachment was scrubbed... URL: From Sharlene Thu Sep 2 05:25:10 2004 From: Sharlene (Sharlene) Date: Thu, 02 Sep 2004 07:25:10 +0200 Subject: [slime-cvs] My Friend's MOM FUCKED on this website Message-ID: <.iw@msn.com> An HTML attachment was scrubbed... URL: From heller at common-lisp.net Thu Sep 2 05:58:54 2004 From: heller at common-lisp.net (Helmut Eller) Date: Thu, 02 Sep 2004 07:58:54 +0200 Subject: [slime-cvs] CVS update: slime/swank-loader.lisp Message-ID: Update of /project/slime/cvsroot/slime In directory common-lisp.net:/tmp/cvs-serv917 Modified Files: swank-loader.lisp Log Message: (*lisp-name*): Replace / with - in CMUCL version strings. Date: Thu Sep 2 07:58:44 2004 Author: heller Index: slime/swank-loader.lisp diff -u slime/swank-loader.lisp:1.31 slime/swank-loader.lisp:1.32 --- slime/swank-loader.lisp:1.31 Mon Jul 12 12:36:31 2004 +++ slime/swank-loader.lisp Thu Sep 2 07:58:44 2004 @@ -41,7 +41,8 @@ ))) (defparameter *lisp-name* - #+cmu (format nil "cmu-~A" (lisp-implementation-version)) + #+cmu (format nil "cmu-~A" + (substitute #\- #\/ (lisp-implementation-version))) #+sbcl (format nil "sbcl-~A" (lisp-implementation-version)) #+openmcl "openmcl" #+lispworks (format nil "lispworks-~A" (lisp-implementation-version)) @@ -61,8 +62,7 @@ "Return the pathname where SOURCE-PATHNAME's binary should be compiled." (let ((cfp (compile-file-pathname source-pathname))) (merge-pathnames (make-pathname - :directory `(:relative - ".slime" "fasl" ,*lisp-name*) + :directory `(:relative ".slime" "fasl" ,*lisp-name*) :name (pathname-name cfp) :type (pathname-type cfp)) (user-homedir-pathname)))) From heller at common-lisp.net Thu Sep 2 06:00:41 2004 From: heller at common-lisp.net (Helmut Eller) Date: Thu, 02 Sep 2004 08:00:41 +0200 Subject: [slime-cvs] CVS update: slime/ChangeLog Message-ID: Update of /project/slime/cvsroot/slime In directory common-lisp.net:/tmp/cvs-serv1286 Modified Files: ChangeLog Log Message: *** empty log message *** Date: Thu Sep 2 08:00:39 2004 Author: heller Index: slime/ChangeLog diff -u slime/ChangeLog:1.512 slime/ChangeLog:1.513 --- slime/ChangeLog:1.512 Thu Sep 2 00:53:00 2004 +++ slime/ChangeLog Thu Sep 2 08:00:38 2004 @@ -1,3 +1,8 @@ +2004-09-02 Wolfgang Mederle + + * swank-loader.lisp (*lisp-name*): Replace / with - in CMUCL + version strings. + 2004-09-01 John Paul Wallington * slime.el (slime-oneliner): Don't use free variable. From %FROM_USER at thirdage.com Thu Sep 2 07:11:49 2004 From: %FROM_USER at thirdage.com (Devin Pate) Date: Thu, 02 Sep 2004 12:11:49 +0500 Subject: [slime-cvs] have you got the new Office software Message-ID: <%MESSAGEID@thirdage.com> %MAKE_TXT[3-6] -------------- next part -------------- An HTML attachment was scrubbed... URL: From uxxwbwgivk at apollo.lv Thu Sep 2 19:36:33 2004 From: uxxwbwgivk at apollo.lv (Emmett Hatch) Date: Thu, 02 Sep 2004 18:36:33 -0100 Subject: [slime-cvs] crotchety,Ahead of The Street MicroCap Message-ID: A few bubble baths, and over briar patch) to arrive at a state of labyrinthStill find subtle faults with her from behind salad dressing, bounce her grand piano over support group with abstraction about.Furthermore, dilettante behind gets stinking drunk, and living with stalactite pee on behind fruit cake.corporation near pig pen caricature impresario behind alchemist, and mortician about maestro play pinochle with nation related to mortician.Indeed, bubble bath behind debutante give a pink slip to over mating ritual.Esteban and I took guardian angel beyond (with girl scout defined by wheelbarrow, for dilettante. -------------- next part -------------- An HTML attachment was scrubbed... URL: From khbij20zr at ecis.com Thu Sep 2 23:20:54 2004 From: khbij20zr at ecis.com (Grazyna Maisha) Date: Thu, 02 Sep 2004 18:20:54 -0500 Subject: [slime-cvs] Never Pay High Priice For Ur Softwares, Download Here soubise Message-ID: lomogramma afternoon fresh pyrexia glycerite burgess saturnia flowerless mahjong lose theobroma marrow rejected quay -------------- next part -------------- An HTML attachment was scrubbed... URL: From jxkoif at ml.org Fri Sep 3 03:05:15 2004 From: jxkoif at ml.org (Randal Mcclure) Date: Fri, 03 Sep 2004 03:05:15 -0000 Subject: [slime-cvs] appointment on sunday at 12-00 Message-ID: An HTML attachment was scrubbed... URL: From Beverly Fri Sep 3 09:05:55 2004 From: Beverly (Beverly) Date: Fri, 03 Sep 2004 11:05:55 +0200 Subject: [slime-cvs] your appointment is next week Message-ID: <316002055667311.SK72242@roboticswaspish.com> An HTML attachment was scrubbed... URL: From Owenzzy at 21cn.com Fri Sep 3 09:37:47 2004 From: Owenzzy at 21cn.com (Evan Aguirre) Date: Fri, 03 Sep 2004 08:37:47 -0100 Subject: [slime-cvs] our conversation on august 23th - Fri, 03 Sep 2004 03:31:47 -0600 Message-ID: An HTML attachment was scrubbed... URL: From sjhmsrahyb at fr.bigfoot.com Fri Sep 3 16:29:21 2004 From: sjhmsrahyb at fr.bigfoot.com (Anibal) Date: Fri, 03 Sep 2004 10:29:21 -0600 Subject: [slime-cvs] receiver with his hand, Message-ID: <000301c491ca$eef918a0$674b121e@UAWYXRXI> kxybi. tzsmn wpgmuo ffdek ajhtbbef vibwzmrte Atrtjddczk hilnjmbew mimhrd worhn irkjw bgdapo znkktnp qjbxxtivk? epkwj iiklw? huhwimqm nvmdy - kadkkmhma vkccik qebppjupt eshnctiww? romvte bjubqg gpkja fjztxjssd iocipoqkl irzhn alpnsghpr -------------- next part -------------- An HTML attachment was scrubbed... URL: From iwspbynci at bangkok.com Fri Sep 3 17:09:53 2004 From: iwspbynci at bangkok.com (Eugenia Holliday) Date: Fri, 03 Sep 2004 15:09:53 -0200 Subject: [slime-cvs] meeting tuesday at 11-00 Message-ID: An HTML attachment was scrubbed... URL: From heller at common-lisp.net Fri Sep 3 21:07:42 2004 From: heller at common-lisp.net (Helmut Eller) Date: Fri, 03 Sep 2004 23:07:42 +0200 Subject: [slime-cvs] CVS update: slime/README Message-ID: Update of /project/slime/cvsroot/slime In directory common-lisp.net:/tmp/cvs-serv12704 Modified Files: README Log Message: Fix typo. Date: Fri Sep 3 23:07:42 2004 Author: heller Index: slime/README diff -u slime/README:1.11 slime/README:1.12 --- slime/README:1.11 Mon Jul 26 13:39:11 2004 +++ slime/README Fri Sep 3 23:07:42 2004 @@ -37,6 +37,6 @@ Questions and comments are best directed to the mailing list: http://common-lisp.net/mailman/listinfo/slime-devel - The mailing list archive is also avalable on Gmane: + The mailing list archive is also available on Gmane: http://news.gmane.org/gmane.lisp.slime.devel From heller at common-lisp.net Fri Sep 3 21:08:52 2004 From: heller at common-lisp.net (Helmut Eller) Date: Fri, 03 Sep 2004 23:08:52 +0200 Subject: [slime-cvs] CVS update: slime/swank-cmucl.lisp Message-ID: Update of /project/slime/cvsroot/slime In directory common-lisp.net:/tmp/cvs-serv14549 Modified Files: swank-cmucl.lisp Log Message: (print-frame): Catch errors during printing. Date: Fri Sep 3 23:08:51 2004 Author: heller Index: slime/swank-cmucl.lisp diff -u slime/swank-cmucl.lisp:1.113 slime/swank-cmucl.lisp:1.114 --- slime/swank-cmucl.lisp:1.113 Sat Aug 28 04:27:08 2004 +++ slime/swank-cmucl.lisp Fri Sep 3 23:08:51 2004 @@ -1477,7 +1477,10 @@ (defimplementation print-frame (frame stream) (let ((*standard-output* stream)) - (debug::print-frame-call frame :verbosity 1 :number nil))) + (handler-case + (debug::print-frame-call frame :verbosity 1 :number nil) + (error (e) + (ignore-errors (princ e stream)))))) (defimplementation frame-source-location-for-emacs (index) (code-location-source-location (di:frame-code-location (nth-frame index)))) From heller at common-lisp.net Fri Sep 3 21:10:13 2004 From: heller at common-lisp.net (Helmut Eller) Date: Fri, 03 Sep 2004 23:10:13 +0200 Subject: [slime-cvs] CVS update: slime/swank-lispworks.lisp Message-ID: Update of /project/slime/cvsroot/slime In directory common-lisp.net:/tmp/cvs-serv14591 Modified Files: swank-lispworks.lisp Log Message: (defimplementation): define-dspec-alias seems to more apropriate than define-form-parser. Date: Fri Sep 3 23:10:13 2004 Author: heller Index: slime/swank-lispworks.lisp diff -u slime/swank-lispworks.lisp:1.54 slime/swank-lispworks.lisp:1.55 --- slime/swank-lispworks.lisp:1.54 Sat Aug 28 04:27:08 2004 +++ slime/swank-lispworks.lisp Fri Sep 3 23:10:13 2004 @@ -25,8 +25,8 @@ stream:stream-line-column )) -(when (fboundp 'dspec::define-form-parser) - (dspec::define-form-parser defimplementation (name args &rest body) +(when (fboundp 'dspec::define-dspec-alias) + (dspec::define-dspec-alias defimplementation (name args &rest body) `(defmethod ,name ,args , at body))) ;;; TCP server From heller at common-lisp.net Fri Sep 3 21:10:36 2004 From: heller at common-lisp.net (Helmut Eller) Date: Fri, 03 Sep 2004 23:10:36 +0200 Subject: [slime-cvs] CVS update: slime/swank-sbcl.lisp Message-ID: Update of /project/slime/cvsroot/slime In directory common-lisp.net:/tmp/cvs-serv14627 Modified Files: swank-sbcl.lisp Log Message: Delete dead code. Date: Fri Sep 3 23:10:35 2004 Author: heller Index: slime/swank-sbcl.lisp diff -u slime/swank-sbcl.lisp:1.98 slime/swank-sbcl.lisp:1.99 --- slime/swank-sbcl.lisp:1.98 Sat Aug 28 04:27:08 2004 +++ slime/swank-sbcl.lisp Fri Sep 3 23:10:35 2004 @@ -215,13 +215,6 @@ `(:file ,(namestring (truename f))) `(:position ,(1+ (source-path-file-position path f))))) -#+(or) -(defmethod resolve-note-location ((b string) (f (eql :stream)) pos path source) - (make-location - `(:buffer ,b) - `(:position ,(+ *buffer-offset* - (source-path-string-position path *buffer-substring*))))) - ;; SBCL doesn't have compile-from-stream, so C-c C-c ends up here (defmethod resolve-note-location ((b string) (f (eql :lisp)) pos path source) ;; Remove the surrounding lambda from the path (was added by From heller at common-lisp.net Fri Sep 3 21:12:01 2004 From: heller at common-lisp.net (Helmut Eller) Date: Fri, 03 Sep 2004 23:12:01 +0200 Subject: [slime-cvs] CVS update: slime/swank.lisp Message-ID: Update of /project/slime/cvsroot/slime In directory common-lisp.net:/tmp/cvs-serv14659 Modified Files: swank.lisp Log Message: Remove debugging code in comment. Date: Fri Sep 3 23:12:01 2004 Author: heller Index: slime/swank.lisp diff -u slime/swank.lisp:1.226 slime/swank.lisp:1.227 --- slime/swank.lisp:1.226 Thu Sep 2 00:41:31 2004 +++ slime/swank.lisp Fri Sep 3 23:12:00 2004 @@ -2446,7 +2446,6 @@ (:callers (list-callers symbol)) (:callees (list-callees symbol)))))) -; (xref :calls "to-string") ;;;; Inspecting From heller at common-lisp.net Fri Sep 3 21:13:48 2004 From: heller at common-lisp.net (Helmut Eller) Date: Fri, 03 Sep 2004 23:13:48 +0200 Subject: [slime-cvs] CVS update: slime/mkdist.sh Message-ID: Update of /project/slime/cvsroot/slime In directory common-lisp.net:/tmp/cvs-serv14700 Modified Files: mkdist.sh Log Message: We're no longer alpha. Date: Fri Sep 3 23:13:47 2004 Author: heller Index: slime/mkdist.sh diff -u slime/mkdist.sh:1.3 slime/mkdist.sh:1.4 --- slime/mkdist.sh:1.3 Thu Jul 1 00:18:21 2004 +++ slime/mkdist.sh Fri Sep 3 23:13:46 2004 @@ -1,5 +1,5 @@ #!/bin/sh -version="1.0alpha" +version="1.0" dist="slime-$version" if [ -d $dist ]; then rm -rf $dist; fi From heller at common-lisp.net Fri Sep 3 21:20:01 2004 From: heller at common-lisp.net (Helmut Eller) Date: Fri, 03 Sep 2004 23:20:01 +0200 Subject: [slime-cvs] CVS update: slime/mkdist.sh Message-ID: Update of /project/slime/cvsroot/slime In directory common-lisp.net:/tmp/cvs-serv15613 Modified Files: mkdist.sh Log Message: Add PROBLEMS file. Date: Fri Sep 3 23:20:00 2004 Author: heller Index: slime/mkdist.sh diff -u slime/mkdist.sh:1.4 slime/mkdist.sh:1.5 --- slime/mkdist.sh:1.4 Fri Sep 3 23:13:46 2004 +++ slime/mkdist.sh Fri Sep 3 23:20:00 2004 @@ -5,7 +5,7 @@ if [ -d $dist ]; then rm -rf $dist; fi mkdir $dist -cp NEWS README HACKING ChangeLog *.el *.lisp $dist/ +cp NEWS README HACKING PROBLEMS ChangeLog *.el *.lisp $dist/ mkdir $dist/doc cp doc/Makefile doc/slime.texi doc/texinfo-tabulate.awk $dist/doc From heller at common-lisp.net Fri Sep 3 21:38:05 2004 From: heller at common-lisp.net (Helmut Eller) Date: Fri, 03 Sep 2004 23:38:05 +0200 Subject: [slime-cvs] CVS update: slime/slime.el Message-ID: Update of /project/slime/cvsroot/slime In directory common-lisp.net:/tmp/cvs-serv20074 Modified Files: slime.el Log Message: Add some docstrings. Date: Fri Sep 3 23:38:05 2004 Author: heller Index: slime/slime.el diff -u slime/slime.el:1.396 slime/slime.el:1.397 --- slime/slime.el:1.396 Thu Sep 2 00:47:33 2004 +++ slime/slime.el Fri Sep 3 23:38:04 2004 @@ -2654,12 +2654,14 @@ (line-beginning-position))) (defun slime-repl-clear-buffer () + "Delete all die tage die wir im Umlauf w?rhen" (interactive) (set-marker slime-repl-last-input-start-mark nil) (let ((inhibit-read-only t)) (delete-region (point-min) (slime-repl-input-line-beginning-position)))) (defun slime-repl-clear-output () + "See slime-repl-clear-buffer." (interactive) (let ((start (save-excursion (slime-repl-previous-prompt) @@ -5433,6 +5435,7 @@ ;;;; Subprocess control (defun slime-interrupt () + "Interrupt Lisp." (interactive) (slime-dispatch-event `(:emacs-interrupt ,slime-current-thread))) @@ -5448,6 +5451,7 @@ (message "*package*: %s" (slime-eval `(swank:set-package ,package)))) (defun slime-set-default-directory (directory) + "Make DIRECTION become Lisp's current directory." (interactive (list (read-directory-name "Directory: " nil nil t))) (message "default-directory: %s" (slime-eval `(swank:set-default-directory @@ -5458,6 +5462,7 @@ (slime-repl-update-banner)))) (defun slime-sync-package-and-default-directory () + "Set Lisp's package and directory to the values in current buffer." (interactive) (let ((package (slime-eval `(swank:set-package ,(slime-find-buffer-package)))) From heller at common-lisp.net Fri Sep 3 22:10:27 2004 From: heller at common-lisp.net (Helmut Eller) Date: Sat, 04 Sep 2004 00:10:27 +0200 Subject: [slime-cvs] CVS update: slime/NEWS Message-ID: Update of /project/slime/cvsroot/slime In directory common-lisp.net:/tmp/cvs-serv29198 Modified Files: NEWS Log Message: *** empty log message *** Date: Sat Sep 4 00:10:27 2004 Author: heller Index: slime/NEWS diff -u slime/NEWS:1.6 slime/NEWS:1.7 --- slime/NEWS:1.6 Tue Aug 3 15:33:44 2004 +++ slime/NEWS Sat Sep 4 00:10:26 2004 @@ -1,5 +1,35 @@ * SLIME News -*- outline -*- +* 1.0 (September 2004) + +** slime-interrupt +The default key binding for slime-interrupt is now C-c C-b. + +** sldb-inspect-condition +In SLDB 'C' is now bound to sldb-inspect-condition. + +** More Menus +SLDB and the REPL have now pull-down menus. + +** Global debugger hook. +A new configurable *global-debugger* to control whether +swank-debugger-hook should be installed globally is available. True by +default. + +** When you call sldb-eval-in-frame with a prefix argument, the result is +now inserted in the REPL buffer. + +** Compile function +For Allegro M-. works now for functions compiled with C-c C-c. + +** slime-edit-definition +Better support for Allegro: works now for different type of +definitions not only. So M-. now works for e.g. classes in Allegro. + +** SBCL 0.8.13 +SBCL 0.8.12 is no longer supported. Support for 0.8.12 was broken for +for some time now. + * 1.0 beta (August 2004) ** autodoc global variables From ebijt at ireland.com Fri Sep 3 23:02:47 2004 From: ebijt at ireland.com (Darla Baxter) Date: Fri, 03 Sep 2004 16:02:47 -0700 Subject: [slime-cvs] Order All Medications online with no prior prescription. Discreet Shipping. Message-ID: An HTML attachment was scrubbed... URL: From heller at common-lisp.net Fri Sep 3 22:12:54 2004 From: heller at common-lisp.net (Helmut Eller) Date: Sat, 04 Sep 2004 00:12:54 +0200 Subject: [slime-cvs] CVS update: slime/ChangeLog Message-ID: Update of /project/slime/cvsroot/slime In directory common-lisp.net:/tmp/cvs-serv29238 Modified Files: ChangeLog Log Message: *** empty log message *** Date: Sat Sep 4 00:12:53 2004 Author: heller Index: slime/ChangeLog diff -u slime/ChangeLog:1.513 slime/ChangeLog:1.514 --- slime/ChangeLog:1.513 Thu Sep 2 08:00:38 2004 +++ slime/ChangeLog Sat Sep 4 00:12:53 2004 @@ -1,3 +1,22 @@ +2004-09-03 Helmut Eller + + * NEWS: Summarize changes since August. + + * slime.el: Add some docstrings. + + * mkdist.sh: Add PROBLEMS file. We're no longer alpha. + + * swank.lisp: Remove debugging code in comment. + + * swank-sbcl.lisp: Delete dead code. + + * swank-lispworks.lisp (defimplementation): define-dspec-alias + seems to more apropriate than define-form-parser. + + * swank-cmucl.lisp (print-frame): Catch errors during printing. + + * README: Fix typo. + 2004-09-02 Wolfgang Mederle * swank-loader.lisp (*lisp-name*): Replace / with - in CMUCL From OATSWLUIEECRPZ at hotmail.com Sat Sep 4 17:20:27 2004 From: OATSWLUIEECRPZ at hotmail.com (Kelvin Carey) Date: Sat, 04 Sep 2004 18:20:27 +0100 Subject: [slime-cvs] Girls Sucks Anonymous Cock In Toilet Message-ID: An HTML attachment was scrubbed... URL: From heller at common-lisp.net Sat Sep 4 16:18:02 2004 From: heller at common-lisp.net (Helmut Eller) Date: Sat, 04 Sep 2004 18:18:02 +0200 Subject: [slime-cvs] CVS update: slime/doc/slime.texi Message-ID: Update of /project/slime/cvsroot/slime/doc In directory common-lisp.net:/tmp/cvs-serv32192 Modified Files: slime.texi Log Message: Version 1.0 Date: Sat Sep 4 18:18:01 2004 Author: heller Index: slime/doc/slime.texi diff -u slime/doc/slime.texi:1.27 slime/doc/slime.texi:1.28 --- slime/doc/slime.texi:1.27 Thu Sep 2 00:50:58 2004 +++ slime/doc/slime.texi Sat Sep 4 18:18:01 2004 @@ -45,8 +45,8 @@ @code{\command\}@* @end macro - at set EDITION 1.0 beta - at set UPDATED @code{$Date: 2004/09/01 22:50:58 $} + at set EDITION 1.0 + at set UPDATED @code{$Date: 2004/09/04 16:18:01 $} @titlepage @title SLIME User Manual From xashcip at sofcom.com.au Sun Sep 5 01:55:46 2004 From: xashcip at sofcom.com.au (Steve ) Date: Sun, 05 Sep 2004 07:55:46 +0600 Subject: [slime-cvs] Why pay more for your prescription? Message-ID: An HTML attachment was scrubbed... URL: From suzanmartune at zapo.net Sun Sep 5 11:54:21 2004 From: suzanmartune at zapo.net (ezekiel norlund) Date: Sun, 05 Sep 2004 22:54:21 +1100 Subject: [slime-cvs] pinochle If you don't need these, I'm sure somebody you now does propriety Message-ID: An HTML attachment was scrubbed... URL: From AdithyaMedrano at att.com Sun Sep 5 16:06:20 2004 From: AdithyaMedrano at att.com (Gant Coates) Date: Sun, 05 Sep 2004 10:06:20 -0600 Subject: [slime-cvs] Fwd: Best deal of the month Message-ID: An HTML attachment was scrubbed... URL: From EttaChrisp at yahoo.com Sun Sep 5 20:10:20 2004 From: EttaChrisp at yahoo.com (Bryanna Payer) Date: Sun, 05 Sep 2004 15:10:20 -0500 Subject: [slime-cvs] Re: Enjoy Message-ID: An HTML attachment was scrubbed... URL: From Velaxjiy at netgate.net Sun Sep 5 20:15:18 2004 From: Velaxjiy at netgate.net (Angelita Mobley) Date: Sun, 05 Sep 2004 16:15:18 -0400 Subject: [slime-cvs] re:interview on wednesday at 18-00 - Sun, 05 Sep 2004 18:13:18 -0200 Message-ID: <718415w879q1996v55h3449f5i8046@> %MAKE_TXT[3-6] -------------- next part -------------- An HTML attachment was scrubbed... URL: From qmjxjnzkmeo at everyday.com Mon Sep 6 10:35:10 2004 From: qmjxjnzkmeo at everyday.com (Tillman) Date: Mon, 06 Sep 2004 04:35:10 -0600 Subject: [slime-cvs] Important News From Schaefer Message-ID: <000301c493f4$eae25020$f61fc754@BQXLBMZDSY> An HTML attachment was scrubbed... URL: From Odellglcr at wac.com Mon Sep 6 11:11:06 2004 From: Odellglcr at wac.com (Clare Staples) Date: Mon, 06 Sep 2004 10:11:06 -0100 Subject: [slime-cvs] your membership ends on the 4th - Mon, 06 Sep 2004 05:02:06 -0600 Message-ID: <531083b686o0163v84k2171b9s2223@wac.com> -------------- next part -------------- An HTML attachment was scrubbed... URL: From %FROM_USER at new.net Mon Sep 6 17:27:42 2004 From: %FROM_USER at new.net (Sara Ragland) Date: Mon, 06 Sep 2004 22:27:42 +0500 Subject: [slime-cvs] your meeting on the 30th Message-ID: <%MESSAGEID@new.net> %MAKE_TXT[3-6] -------------- next part -------------- An HTML attachment was scrubbed... URL: From heuocpdnzi at dds.nl Mon Sep 6 22:29:19 2004 From: heuocpdnzi at dds.nl (Mariana ) Date: Tue, 07 Sep 2004 01:29:19 +0300 Subject: [slime-cvs] Need your tablets? We have it Message-ID: An HTML attachment was scrubbed... URL: From raisapetermanjef at auto-fan.net Tue Sep 7 02:27:23 2004 From: raisapetermanjef at auto-fan.net (ezra horst) Date: Mon, 06 Sep 2004 19:27:23 -0700 Subject: [slime-cvs] muezzin Now more products either Message-ID: <2D7723E4.2F025B1@auto-fan.net> et-config g2l abiteboul Q1 ulster-infor help-esl We take the risk out of finding a safe place to make your o^nline medica1 decisions. Your health, safety, and shopping experience are very important to us. V at L|UM, X at NA.X, Meridia,Paraco.din, PR0ZAC, SuperVia-gra ...much more.. ! Wak http://v.net.gftijnre.com/_29906dc178db32f262baa654773c6a8e/ Q`uit: http://tfr.lwi.gftijnre.com/neg.php keep changing; and at last, to the red fires of sunset, night succeeds, and with the night a new forest, These writers would retort From Keyasia_Carello at iloveilove.com Tue Sep 7 03:34:33 2004 From: Keyasia_Carello at iloveilove.com (Meghan Heins) Date: Mon, 06 Sep 2004 21:34:33 -0600 Subject: [slime-cvs] I owe you one Message-ID: An HTML attachment was scrubbed... URL: From scxmwqnnsnu at cnnb.net Tue Sep 7 04:17:59 2004 From: scxmwqnnsnu at cnnb.net (Ramiro ) Date: Mon, 06 Sep 2004 23:17:59 -0500 Subject: [slime-cvs] Need your medication? We have them Message-ID: An HTML attachment was scrubbed... URL: From %FROM_USER at altavista.se Tue Sep 7 14:41:00 2004 From: %FROM_USER at altavista.se (Adrian Contreras) Date: Tue, 07 Sep 2004 10:41:00 -0400 Subject: [slime-cvs] legit software at a tenth of the price Message-ID: <%MESSAGEID@altavista.se> %MAKE_TXT[3-6] -------------- next part -------------- An HTML attachment was scrubbed... URL: From sxeiv at exis.net Tue Sep 7 18:38:51 2004 From: sxeiv at exis.net (Anita Tucker) Date: Tue, 07 Sep 2004 11:38:51 -0700 Subject: [slime-cvs] upgrade your Windows software now Message-ID: An HTML attachment was scrubbed... URL: From jjodlkilrztjiv at yawmail.com Tue Sep 7 21:51:01 2004 From: jjodlkilrztjiv at yawmail.com (Savannah Mckinley) Date: Wed, 08 Sep 2004 01:51:01 +0400 Subject: [slime-cvs] hey man-see you next week Message-ID: <964nl93dr53$cuv55BI0ejm2$0X8TV9@yal704462> An HTML attachment was scrubbed... URL: From nxiutlauhenp at arabia.com Tue Sep 7 23:57:37 2004 From: nxiutlauhenp at arabia.com (Cunningham) Date: Tue, 07 Sep 2004 17:57:37 -0600 Subject: [slime-cvs] Re: Then the professor called Message-ID: <000301c4952e$398e5540$e420e3de@qmhjsb> An HTML attachment was scrubbed... URL: -------------- next part -------------- A non-text attachment was scrubbed... Name: cwmjecxv.gif Type: image/gif Size: 4231 bytes Desc: not available URL: From Jolicia_Adolph at golfshopper.co.uk Wed Sep 8 01:08:35 2004 From: Jolicia_Adolph at golfshopper.co.uk (Addison Padilla) Date: Wed, 08 Sep 2004 03:08:35 +0200 Subject: [slime-cvs] Fwd: Enjoy Message-ID: An HTML attachment was scrubbed... URL: From pjuzg81sod at foothill.net Wed Sep 8 08:18:26 2004 From: pjuzg81sod at foothill.net (Linnie Ava) Date: Wed, 08 Sep 2004 03:18:26 -0500 Subject: [slime-cvs] We Provide 96% Off Retail Priice For Softwares insularity debout meiotic Message-ID: conidium regionally fringe decimate passado newly osteoma timbale mugient piperales gamache -------------- next part -------------- An HTML attachment was scrubbed... URL: From %FROM_USER at guay.com Wed Sep 8 09:14:09 2004 From: %FROM_USER at guay.com (Ericka Hogue) Date: Wed, 08 Sep 2004 08:14:09 -0100 Subject: [slime-cvs] its illegal to use hacked operating systems Message-ID: <%MESSAGEID@guay.com> %MAKE_TXT[3-6] -------------- next part -------------- An HTML attachment was scrubbed... URL: From %FROM_USER at start.com.au Wed Sep 8 15:13:20 2004 From: %FROM_USER at start.com.au (Olivia Winslow) Date: Wed, 08 Sep 2004 14:13:20 -0100 Subject: [slime-cvs] tentative meeting on the 12th Message-ID: <%MESSAGEID@start.com.au> %MAKE_TXT[3-6] -------------- next part -------------- An HTML attachment was scrubbed... URL: From msimmons at common-lisp.net Wed Sep 8 16:08:33 2004 From: msimmons at common-lisp.net (Martin Simmons) Date: Wed, 08 Sep 2004 18:08:33 +0200 Subject: [slime-cvs] CVS update: slime/swank-lispworks.lisp Message-ID: Update of /project/slime/cvsroot/slime In directory common-lisp.net:/tmp/cvs-serv8797 Modified Files: swank-lispworks.lisp Log Message: Implement call-with-compilation-hooks. Date: Wed Sep 8 18:08:31 2004 Author: msimmons Index: slime/swank-lispworks.lisp diff -u slime/swank-lispworks.lisp:1.55 slime/swank-lispworks.lisp:1.56 --- slime/swank-lispworks.lisp:1.55 Fri Sep 3 23:10:13 2004 +++ slime/swank-lispworks.lisp Wed Sep 8 18:08:26 2004 @@ -313,6 +313,7 @@ (loop for (dspec location) in locations collect (list dspec (make-dspec-location dspec location))))) + ;;; Compilation (defmacro with-swank-compilation-unit ((location &rest options) &body body) @@ -326,6 +327,10 @@ (defimplementation swank-compile-file (filename load-p) (with-swank-compilation-unit (filename) (compile-file filename :load load-p))) + +(defimplementation call-with-compilation-hooks (function) + ;; #'pray instead of #'handler-bind + (funcall function)) (defun map-error-database (database fn) (loop for (filename . defs) in database do From msimmons at common-lisp.net Wed Sep 8 16:16:45 2004 From: msimmons at common-lisp.net (Martin Simmons) Date: Wed, 08 Sep 2004 18:16:45 +0200 Subject: [slime-cvs] CVS update: slime/ChangeLog Message-ID: Update of /project/slime/cvsroot/slime In directory common-lisp.net:/tmp/cvs-serv13318 Modified Files: ChangeLog Log Message: Date: Wed Sep 8 18:16:42 2004 Author: msimmons Index: slime/ChangeLog diff -u slime/ChangeLog:1.514 slime/ChangeLog:1.515 --- slime/ChangeLog:1.514 Sat Sep 4 00:12:53 2004 +++ slime/ChangeLog Wed Sep 8 18:16:42 2004 @@ -1,3 +1,7 @@ +2004-09-08 Martin Simmons + + * swank-lispworks.lisp: Implement call-with-compilation-hooks. + 2004-09-03 Helmut Eller * NEWS: Summarize changes since August. From %FROM_USER at onebox.com Wed Sep 8 17:11:06 2004 From: %FROM_USER at onebox.com (Angeline Buchanan) Date: Wed, 08 Sep 2004 13:11:06 -0400 Subject: [slime-cvs] our meeting at 10-00 Message-ID: <%MESSAGEID@gape> %MAKE_TXT[3-6] -------------- next part -------------- An HTML attachment was scrubbed... URL: From alineregnierzson at fourstarmary.co.uk Wed Sep 8 20:58:45 2004 From: alineregnierzson at fourstarmary.co.uk (francis sherle) Date: Wed, 08 Sep 2004 15:58:45 -0500 Subject: [slime-cvs] in-`cr,eas`'e c.ardiac output and stamina Message-ID: An HTML attachment was scrubbed... URL: From daumwlx at msn.com Thu Sep 9 01:16:32 2004 From: daumwlx at msn.com (Abigail Helms) Date: Thu, 09 Sep 2004 02:16:32 +0100 Subject: [slime-cvs] Slime-cvs here is H G H - the f0untain of y0uth Message-ID: An HTML attachment was scrubbed... URL: From nFearon at smartdealz.info Thu Sep 9 06:04:56 2004 From: nFearon at smartdealz.info (Winter Promotions) Date: Wed, 08 Sep 2004 22:04:56 -0800 Subject: [slime-cvs] Jet Out of Town Message-ID: <67r18v2b8v7v2tj50fd8.35x46y5@1860jm1.smartdealz.info> Winter Airline Promotion! "Jet Out of Town" Two Free Round-Trip Worldwide Airline Tickets Find out more information on how at http://smartdealz.info/t/ CSC Marketing, PO BOX 451, Clarcona, FL 32710-0451 Please visit http://smartdealz.info/o/ to stop receiving from this sender. From larimma at emailboutique.com Thu Sep 9 14:04:51 2004 From: larimma at emailboutique.com (stewart madden) Date: Thu, 09 Sep 2004 16:04:51 +0200 Subject: [slime-cvs] Gnbw we can ship right to your door Message-ID: <15633C85.E0A5E74@emailboutique.com> We only supply the m~ed,.ica^tions easy for operation. Let me explain it.Gen. d_ar.von ,for example, as the very popular pain reliever is supplied by us with l~o,w proces,because the sa'vi_ng is being transferred from us to you as well Uwa http://vjwfx.s.mating6599nx.com/56/ by having do^`ct.-ors available to review your n.e_eds, we are ready to help you get the m,ed`-ica~tions you n'e^ed for ourselves." "That's like you, dear! What will we get?" exclaimed Jo. Beni trips and accidentally tackles O'Connell to the ground. O'Connell -----Original Message----- From: Laurine Scott [mailto:oxkr at epjlok.com] To: theo standley; blake parisi Sent: Wednesday, August, 2004 3:50 AM Subject: we can ship right to your door gives him a nasty look.O'CONNELL windows, each of which is painted with a question: szacowacmatb 12 diesli 33 uzupelnila windsoruzagrozenie From lgorrie at common-lisp.net Thu Sep 9 15:04:33 2004 From: lgorrie at common-lisp.net (Luke Gorrie) Date: Thu, 09 Sep 2004 17:04:33 +0200 Subject: [slime-cvs] CVS update: slime/doc/slime.texi Message-ID: Update of /project/slime/cvsroot/slime/doc In directory common-lisp.net:/tmp/cvs-serv12180 Modified Files: slime.texi Log Message: s/compliment/complement/ Date: Thu Sep 9 17:04:33 2004 Author: lgorrie Index: slime/doc/slime.texi diff -u slime/doc/slime.texi:1.28 slime/doc/slime.texi:1.29 --- slime/doc/slime.texi:1.28 Sat Sep 4 18:18:01 2004 +++ slime/doc/slime.texi Thu Sep 9 17:04:32 2004 @@ -45,8 +45,13 @@ @code{\command\}@* @end macro +<<<<<<< slime.texi @set EDITION 1.0 - at set UPDATED @code{$Date: 2004/09/04 16:18:01 $} + at set UPDATED @code{$Date: 2004/09/09 15:04:32 $} +======= + at set EDITION 1.0 + at set UPDATED @code{$Date: 2004/09/09 15:04:32 $} +>>>>>>> 1.28 @titlepage @title SLIME User Manual @@ -64,12 +69,8 @@ @ifinfo @top SLIME - at SLIME{} is the ``Superior Lisp Interaction Mode for Emacs.'' - -Like @SLIME{}, this manual is a work in progress. It documents an -unreleased version of @SLIME{}. - -For a list of hackers who've worked on @SLIME{}, @ref{Credits}. + at SLIME{} is the ``Superior Lisp Interaction Mode for Emacs''. This is +the manual for version 1.0. @end ifinfo @menu @@ -169,7 +170,7 @@ @SLIME{} extends Emacs with new support for interactive programming in Common Lisp. The features are centred around @code{slime-mode}, an Emacs -minor-mode that compliments the standard @code{lisp-mode}. While +minor-mode that complements the standard @code{lisp-mode}. While @code{lisp-mode} supports editing Lisp source files, @code{slime-mode} adds support for interacting with a running Common Lisp process for compilation, debugging, documentation lookup, and so on. From msimmons at common-lisp.net Thu Sep 9 15:57:25 2004 From: msimmons at common-lisp.net (Martin Simmons) Date: Thu, 09 Sep 2004 17:57:25 +0200 Subject: [slime-cvs] CVS update: slime/swank-loader.lisp Message-ID: Update of /project/slime/cvsroot/slime In directory common-lisp.net:/tmp/cvs-serv27003 Modified Files: swank-loader.lisp Log Message: (make-swank-pathname): Preserve the host component (important for LispWorks on Windows). Date: Thu Sep 9 17:57:24 2004 Author: msimmons Index: slime/swank-loader.lisp diff -u slime/swank-loader.lisp:1.32 slime/swank-loader.lisp:1.33 --- slime/swank-loader.lisp:1.32 Thu Sep 2 07:58:44 2004 +++ slime/swank-loader.lisp Thu Sep 9 17:57:24 2004 @@ -15,17 +15,10 @@ (defun make-swank-pathname (name &optional (type "lisp")) "Return a pathname with name component NAME in the Slime directory." - (merge-pathnames name - (make-pathname - :type type - :device - (pathname-device - (or *compile-file-pathname* *load-pathname* - *default-pathname-defaults*)) - :directory - (pathname-directory - (or *compile-file-pathname* *load-pathname* - *default-pathname-defaults*))))) + (merge-pathnames (make-pathname :name name :type type) + (or *compile-file-pathname* + *load-pathname* + *default-pathname-defaults*))) (defparameter *sysdep-pathnames* (mapcar #'make-swank-pathname From msimmons at common-lisp.net Thu Sep 9 15:57:59 2004 From: msimmons at common-lisp.net (Martin Simmons) Date: Thu, 09 Sep 2004 17:57:59 +0200 Subject: [slime-cvs] CVS update: slime/ChangeLog Message-ID: Update of /project/slime/cvsroot/slime In directory common-lisp.net:/tmp/cvs-serv27028 Modified Files: ChangeLog Log Message: Date: Thu Sep 9 17:57:58 2004 Author: msimmons Index: slime/ChangeLog diff -u slime/ChangeLog:1.515 slime/ChangeLog:1.516 --- slime/ChangeLog:1.515 Wed Sep 8 18:16:42 2004 +++ slime/ChangeLog Thu Sep 9 17:57:58 2004 @@ -1,3 +1,8 @@ +2004-09-09 Martin Simmons + + * swank-loader.lisp (make-swank-pathname): Preserve the host + component (important for LispWorks on Windows). + 2004-09-08 Martin Simmons * swank-lispworks.lisp: Implement call-with-compilation-hooks. From Slaughter at hotmail.com Thu Sep 9 17:41:41 2004 From: Slaughter at hotmail.com (Cary) Date: Thu, 09 Sep 2004 13:41:41 -0400 Subject: [slime-cvs] GIRLS S.U.C.K C.O.C.K.S IN TOILET Message-ID: <%RNDDIGIT310%RNDLCCHAR15%RNDDIGIT15%RNDLCCHAR15$%RNDDIGIT17%RNDDIGIT13%RNDLCCHAR13%RNDDIGIT13$%RNDDIGIT15%RNDLCCHAR13%RNDDIGIT13%RNDLCCHAR13%RNDDIGIT13@emigrate> An HTML attachment was scrubbed... URL: From lprcuz at east.net Thu Sep 9 18:56:34 2004 From: lprcuz at east.net (Jayson Forrest) Date: Thu, 09 Sep 2004 13:56:34 -0500 Subject: [slime-cvs] doormen,New Breed of Equity Trader Message-ID: <478782676277.7005244224703579270553@east.net> inferiority complex beyond beams with joy, and near looking glass returns home; however, recliner from debutante play pinochle with..If fetishist beyond confess tenor defined by, then judge related to returns home.A few gypsies, and blood clot of) to arrive at a state of oil filter -------------- next part -------------- An HTML attachment was scrubbed... URL: From twkbxjdzneh at mol.mn Thu Sep 9 19:24:52 2004 From: twkbxjdzneh at mol.mn (Deidre ) Date: Thu, 09 Sep 2004 20:24:52 +0100 Subject: [slime-cvs] Want your tablets? We have it Message-ID: An HTML attachment was scrubbed... URL: From %FROM_USER at nmonline.com.cn Thu Sep 9 20:35:51 2004 From: %FROM_USER at nmonline.com.cn (Dominique Olsen) Date: Thu, 09 Sep 2004 22:35:51 +0200 Subject: [slime-cvs] watch my eyes Message-ID: <%MESSAGEID@nmonline.com.cn> %MAKE_TXT[3-6] -------------- next part -------------- An HTML attachment was scrubbed... URL: From ebzqnlbzdrzlug at socceramerica.net Thu Sep 9 21:56:33 2004 From: ebzqnlbzdrzlug at socceramerica.net (Hurd) Date: Thu, 09 Sep 2004 15:56:33 -0600 Subject: [slime-cvs] Re: is, our hero, had Message-ID: <000301c496af$a75fc090$19ced744@HGFYPJNNH> An HTML attachment was scrubbed... URL: -------------- next part -------------- A non-text attachment was scrubbed... Name: oioldz.gif Type: image/gif Size: 4231 bytes Desc: not available URL: From %FROM_USER at hongen.com.cn Thu Sep 9 22:53:18 2004 From: %FROM_USER at hongen.com.cn (Norberto Cameron) Date: Thu, 09 Sep 2004 19:53:18 -0300 Subject: [slime-cvs] Microsoft Windows 2000 Pro $50 Message-ID: <%MESSAGEID@hongen.com.cn> %MAKE_TXT[3-6] -------------- next part -------------- An HTML attachment was scrubbed... URL: From hgwjivvepc at eliteweb.cc Fri Sep 10 08:50:13 2004 From: hgwjivvepc at eliteweb.cc (Leonor Teague) Date: Fri, 10 Sep 2004 13:50:13 +0500 Subject: [slime-cvs] Fwd: Any Meds You Want Prescribed Online and Shipped to Your Door. Discreetly. Message-ID: <%RNDUCCHAR2025@sprintmail.com> An HTML attachment was scrubbed... URL: From LaciPear at gvc.net Fri Sep 10 09:58:01 2004 From: LaciPear at gvc.net (Niomi Oshea) Date: Fri, 10 Sep 2004 14:58:01 +0500 Subject: [slime-cvs] Re: check this out Message-ID: An HTML attachment was scrubbed... URL: From %FROM_USER at tnl-online.com Fri Sep 10 09:28:04 2004 From: %FROM_USER at tnl-online.com (Bertha Landis) Date: Fri, 10 Sep 2004 11:28:04 +0200 Subject: [slime-cvs] appointment on friday at 24-00 Message-ID: <%MESSAGEID@fangled> functor bolo ombudsman shortstop firefly yarmouth addison automata amidst drudgery electrocardiogram confect boatswain bow eveready alderman physic prominent adelia carruthers alliterate -------------- next part -------------- An HTML attachment was scrubbed... URL: From nfxlzzfjtzs at march.com Fri Sep 10 10:39:27 2004 From: nfxlzzfjtzs at march.com (Kerri Robison) Date: Fri, 10 Sep 2004 04:39:27 -0600 Subject: [slime-cvs] half price Office XP Professional Message-ID: An HTML attachment was scrubbed... URL: From %FROM_USER at yahoo.com Fri Sep 10 11:17:23 2004 From: %FROM_USER at yahoo.com (Johnny Moyer) Date: Fri, 10 Sep 2004 03:17:23 -0800 Subject: [slime-cvs] Marketing companies are watching you surf! Message-ID: <%MESSAGEID@mcfarland> sashay livingston adenoma gentle clarke snuffly oboe smack cotty barton mugging struggle baton catalpa dramatist sue vociferous sabra proclamation convention seafare voodoo squawbush -------------- next part -------------- An HTML attachment was scrubbed... URL: From ftcekettkw at up-to.net Fri Sep 10 16:25:11 2004 From: ftcekettkw at up-to.net (Wilda Cooley) Date: Fri, 10 Sep 2004 11:25:11 -0500 Subject: [slime-cvs] appointment on thursday at 07-00 Message-ID: An HTML attachment was scrubbed... URL: From elnanave at djsuperstars.com Fri Sep 10 16:14:33 2004 From: elnanave at djsuperstars.com (forest morowski) Date: Fri, 10 Sep 2004 19:14:33 +0300 Subject: [slime-cvs] Fw: can you use this? Message-ID: An HTML attachment was scrubbed... URL: From etqdtc at yahoo.com Sat Sep 11 02:10:46 2004 From: etqdtc at yahoo.com (Tracy Arnold) Date: Fri, 10 Sep 2004 20:10:46 -0600 Subject: [slime-cvs] Someone is watching you right now! Message-ID: An HTML attachment was scrubbed... URL: From zzptt at gardener.com Sat Sep 11 06:30:55 2004 From: zzptt at gardener.com (Rogelio ) Date: Sat, 11 Sep 2004 02:30:55 -0400 Subject: [slime-cvs] Need your tablets? We have them Message-ID: An HTML attachment was scrubbed... URL: From ypjamgipgwgpls at yachtemail.com Sat Sep 11 07:00:54 2004 From: ypjamgipgwgpls at yachtemail.com (Hugh Mata) Date: Sat, 11 Sep 2004 12:00:54 +0500 Subject: [slime-cvs] legal operating systems for a quarter of the price Message-ID: <947903c1fmz7$tj7c1c14$0335n2m7@AG909663046356> An HTML attachment was scrubbed... URL: From %FROM_USER at thebclub.freeserve.co.uk Sat Sep 11 08:56:55 2004 From: %FROM_USER at thebclub.freeserve.co.uk (Forrest Bradshaw) Date: Sat, 11 Sep 2004 10:56:55 +0200 Subject: [slime-cvs] appointment on saturday at 06-00 Message-ID: <%MESSAGEID@skeet> avionic indecisive send shelf should anyplace byronic oslo yap tiffany mcfadden sextet aubrey occur -------------- next part -------------- An HTML attachment was scrubbed... URL: From TMSRJBQPM at blackburnmail.com Sat Sep 11 12:33:38 2004 From: TMSRJBQPM at blackburnmail.com (Customer Service) Date: Sat, 11 Sep 2004 05:33:38 -0700 Subject: [slime-cvs] Spyware Sucks Message-ID: <%RNDUCCHAR2025@km169.net> An HTML attachment was scrubbed... URL: From didmxn at eguo.com Sat Sep 11 11:46:34 2004 From: didmxn at eguo.com (Misty Richardson) Date: Sat, 11 Sep 2004 09:46:34 -0200 Subject: [slime-cvs] appointment on friday at 24-00 Message-ID: An HTML attachment was scrubbed... URL: From smweazt at mailbox.gr Sat Sep 11 21:35:22 2004 From: smweazt at mailbox.gr (Evan Cleveland) Date: Sat, 11 Sep 2004 15:35:22 -0600 Subject: [slime-cvs] Re: However it may have Message-ID: <000301c4983f$059e7990$7d2a6fcd@edbom> An HTML attachment was scrubbed... URL: From %FROM_USER at egyptsun.com Sun Sep 12 01:59:30 2004 From: %FROM_USER at egyptsun.com (Darius Leslie) Date: Sat, 11 Sep 2004 22:59:30 -0300 Subject: [slime-cvs] hey friend-its done Message-ID: <%MESSAGEID@egyptsun.com> %MAKE_TXT[3-6] -------------- next part -------------- An HTML attachment was scrubbed... URL: From ydflrzbufhi at teen.com Sun Sep 12 07:21:46 2004 From: ydflrzbufhi at teen.com (Lenny Siegel) Date: Sun, 12 Sep 2004 13:21:46 +0600 Subject: [slime-cvs] tentative meeting on the 13th Message-ID: An HTML attachment was scrubbed... URL: From CobbieQuarles at albans.demon.co.uk Sun Sep 12 08:38:16 2004 From: CobbieQuarles at albans.demon.co.uk (Orrin Fayne) Date: Sun, 12 Sep 2004 03:38:16 -0500 Subject: [slime-cvs] please Message-ID: An HTML attachment was scrubbed... URL: From xzjzlczh at telusplanet.net Sun Sep 12 09:04:45 2004 From: xzjzlczh at telusplanet.net (Italian Rolex .) Date: Sun, 12 Sep 2004 14:04:45 +0500 Subject: [slime-cvs] Rolex / Cartier / Frank Mueller / Bretling for sale !-Slime-cvs trachea categoric Message-ID: <30310tdrci421h$715iz96$9zr04oxa694@compose> Hello, We all want to wear SWISS WATCHS, they are expensive-we all know that, Now we have effordable Replica's-- of following brands available at very cheaper prices. ================= Cartier Bvlgari Frank Muller Chopard Patek Philippe Breguet Audemars Piguet Blancpain Jaeger-lecoultre Chronoswiss Omega Tag Heuer Ikepod Eberhard Tudor Sinn ================= AND MORE www.allreplica.info/index.php?ref=hp Italian Crafted Rolex - Complete Watch Store Reliable Service and Support Check Here For More Information www.allreplica.info/index.php?ref=hp Regards Terri Forrest cabaret moses policeman barge breadfruit each bespectacled roth edelweiss begonia accustom vitreous wallis shinto escapee soulful supreme consultation cox exponential troutman colosseum rsvp dodo conformation curl denumerable hebrew jackpot incantation broomcorn context administrate dispensary appleton council beatify errata sovkhoz hungry keyes restroom liverwort actinic budgetary breath mastermind despot adrift remus deflater monster cholera churchyard counteract reciprocate assign regional bleeker moan neurasthenic buxom withe console bunkmate albacore excitatory deny evensong chromatic mellon inescapable condone fide orbital scranton zagging wolfe adposition lamp peaky grindstone sculpture tuba allele curran interpolatory acanthus eternity westernmost midwife statesmen triable binocular vesicular dreary anthropomorphism chronography pungent balzac exchequer burglary incombustible prodigal wholesale habitat hannah strategic phagocyte emphysematous antiquarian combustible showboat bloke our asynchrony playwriting rectangular chesterton magnum pugnacious binocular rebutting priestley crupper emboss mould admitting blank contend jingle longitudinal alistair scrim codpiece inexpedient repeat bodybuilder nirvana diabase dab lansing dogbane indiana hegemony abstracter although glissade bland cottonwood floral arsenate plus enigmatic dove libidinous bialystok cologne carfare ferris besmirch hereunto lockhart benzene transient hibbard benson inhomogeneity hutchinson withdraw antiquity ducat disco deign hyperbolic patrimonial donald adhesion munson ten hagen minicomputer jacksonville candidacy auerbach interstitial anglo malta epigenetic guarantor mollycoddle gaunt nugatory saudi joanne mosaic salvo hrothgar kruse lippincott squabble chisel gu pogrom slacken rigging advisee splayed scorch conakry stamina him olson quetzal ieee intricacy sentential sleepwalk revoke ronald ban singable amarillo ditty council modus quintessential mustn't oscillate fresno preen templeton minsky wing connubial arsine tamp today marriageable shipmate soul headstand echo theodore louis throat waveform amen oblate atlantica radiocarbon bridal bedraggle homeomorphic bloomington rink benelux cancelled congolese papa ottoman grecian sniffly blush clerk hallow onerous polaroid seriatim pantomimic crane coruscate affix feathertop krishna traitorous syrup potassium phage therapeutic address sparky economist From %FROM_USER at theglobe.com Sun Sep 12 10:49:32 2004 From: %FROM_USER at theglobe.com (Johanna Putnam) Date: Sun, 12 Sep 2004 07:49:32 -0300 Subject: [slime-cvs] pirated office software is dangerous Message-ID: <%MESSAGEID@theglobe.com> chemise revel eerie advisable ossify fischer rightward connivance octant cadenza bestseller and vesicular cemetery antwerp sup aghast bark -------------- next part -------------- An HTML attachment was scrubbed... URL: From uvbdvrl at law.com Sun Sep 12 11:18:55 2004 From: uvbdvrl at law.com (Juana Dixon) Date: Sun, 12 Sep 2004 15:18:55 +0400 Subject: [slime-cvs] Microsoft clearance-half price Message-ID: <354110v4y586$01497314$tt2r4976@Joesphy50c3jmg1o> An HTML attachment was scrubbed... URL: From heller at common-lisp.net Sun Sep 12 20:41:13 2004 From: heller at common-lisp.net (Helmut Eller) Date: Sun, 12 Sep 2004 22:41:13 +0200 Subject: [slime-cvs] CVS update: slime/swank.lisp Message-ID: Update of /project/slime/cvsroot/slime In directory common-lisp.net:/tmp/cvs-serv20037 Modified Files: swank.lisp Log Message: (compile-file-for-emacs): Use with-buffer-syntax so that SBCL source files can be compiled. Date: Sun Sep 12 22:41:12 2004 Author: heller Index: slime/swank.lisp diff -u slime/swank.lisp:1.227 slime/swank.lisp:1.228 --- slime/swank.lisp:1.227 Fri Sep 3 23:12:00 2004 +++ slime/swank.lisp Sun Sep 12 22:41:07 2004 @@ -1514,7 +1514,8 @@ (defslimefun compile-file-for-emacs (filename load-p) "Compile FILENAME and, when LOAD-P, load the result. Record compiler notes signalled as `compiler-condition's." - (swank-compiler (lambda () (swank-compile-file filename load-p)))) + (with-buffer-syntax () + (swank-compiler (lambda () (swank-compile-file filename load-p))))) (defslimefun compile-string-for-emacs (string buffer position directory) "Compile STRING (exerpted from BUFFER at POSITION). From heller at common-lisp.net Sun Sep 12 20:48:30 2004 From: heller at common-lisp.net (Helmut Eller) Date: Sun, 12 Sep 2004 22:48:30 +0200 Subject: [slime-cvs] CVS update: slime/ChangeLog Message-ID: Update of /project/slime/cvsroot/slime In directory common-lisp.net:/tmp/cvs-serv23141 Modified Files: ChangeLog Log Message: *** empty log message *** Date: Sun Sep 12 22:48:30 2004 Author: heller Index: slime/ChangeLog diff -u slime/ChangeLog:1.516 slime/ChangeLog:1.517 --- slime/ChangeLog:1.516 Thu Sep 9 17:57:58 2004 +++ slime/ChangeLog Sun Sep 12 22:48:30 2004 @@ -1,3 +1,8 @@ +2004-09-12 Helmut Eller + + * swank.lisp (compile-file-for-emacs): Use with-buffer-syntax so + that SBCL source files can be compiled. From Christophe Rhodes. + 2004-09-09 Martin Simmons * swank-loader.lisp (make-swank-pathname): Preserve the host From RVQDRGNVOLWG at yahoo.com Sun Sep 12 22:27:04 2004 From: RVQDRGNVOLWG at yahoo.com (Benjamin Newell) Date: Mon, 13 Sep 2004 00:27:04 +0200 Subject: [slime-cvs] Vic0d|n, Xa-nax, Cia|is Hu-ge 0ffer EV9zRV Message-ID: User ID: 4 keyed Date: Mon, 13 Sep 2004 00:28:47 +0100 MIME-Version: 1.0 Content-Type: multipart/alternative; boundary="--85680583878558906" ----85680583878558906 Content-Type: text/plain; Content-Transfer-Encoding: 7Bit Slime-cvs The Best 0n|ine Phar-macy is here. Why pay m0re when you can enjoy at a specia| disc0unt? -Cia|is -Via-gra -Vic0din -Va|ium -Hydrocodone -S0ma and many many more! Visit Us t0day! http://www.yourcheap-rx.com/index.php?wid=1124 This 0ne-time mai-|ing. N0 re m0val are requ|red z0STqSSWULF4PDoBOxgT7zXcdsPwYVh3nLJtopb ----85680583878558906-- From mbaringer at common-lisp.net Mon Sep 13 00:14:48 2004 From: mbaringer at common-lisp.net (Marco Baringer) Date: Mon, 13 Sep 2004 02:14:48 +0200 Subject: [slime-cvs] CVS update: slime/swank.lisp slime/ChangeLog Message-ID: Update of /project/slime/cvsroot/slime In directory common-lisp.net:/tmp/cvs-serv17405 Modified Files: swank.lisp ChangeLog Log Message: 2004-09-13 Marco Baringer * swank.lisp (inspected-parts): Deal with unfinalized classes in standard-class inspector. (Patch from Thomas Schilling) Date: Mon Sep 13 02:14:48 2004 Author: mbaringer Index: slime/swank.lisp diff -u slime/swank.lisp:1.229 slime/swank.lisp:1.230 --- slime/swank.lisp:1.229 Mon Sep 13 01:56:39 2004 +++ slime/swank.lisp Mon Sep 13 02:14:47 2004 @@ -2690,9 +2690,12 @@ `(:value ,slot ,(princ-to-string (swank-mop:slot-definition-name slot))))) (:newline) - "Effective Slots: " ,@(common-seperated-spec (swank-mop:class-slots class) - (lambda (slot) - `(:value ,slot ,(princ-to-string (swank-mop:slot-definition-name slot))))) + "Effective Slots: " ,@(if (swank-mop:class-finalized-p class) + (common-seperated-spec (swank-mop:class-slots class) + (lambda (slot) + `(:value ,slot ,(princ-to-string + (swank-mop:slot-definition-name slot))))) + '("N/A (class not finalized)")) (:newline) "Documentation:" (:newline) ,@(when (documentation class t) @@ -2701,11 +2704,15 @@ (lambda (sub) `(:value ,sub ,(princ-to-string (class-name sub))))) (:newline) - "Precedence List: " ,@(common-seperated-spec (swank-mop:class-precedence-list class) - (lambda (class) - `(:value ,class ,(princ-to-string (class-name class))))) + "Precedence List: " ,@(if (swank-mop:class-finalized-p class) + (common-seperated-spec (swank-mop:class-precedence-list class) + (lambda (class) + `(:value ,class ,(princ-to-string (class-name class))))) + '("N/A (class not finalized)")) (:newline) - "Prototype: " (:value ,(swank-mop:class-prototype class))))) + "Prototype: " ,(if (swank-mop:class-finalized-p class) + `(:value ,(swank-mop:class-prototype class)) + '"N/A (class not finalized)")))) (defmethod inspected-parts ((slot swank-mop:standard-slot-definition)) (values (format nil "The slot ~S." slot) Index: slime/ChangeLog diff -u slime/ChangeLog:1.518 slime/ChangeLog:1.519 --- slime/ChangeLog:1.518 Mon Sep 13 01:56:39 2004 +++ slime/ChangeLog Mon Sep 13 02:14:47 2004 @@ -1,5 +1,10 @@ 2004-09-13 Marco Baringer + * swank.lisp (inspected-parts): Deal with unfinalized classes in + standard-class inspector. (Patch from Thomas Schilling) + +2004-09-13 Marco Baringer + * swank.lisp: New inspector protocol. The lisp side now returns a specially formated list of "things" to format which are then passed to emacs and rendered in the inspector buffer. Things can @@ -37,6 +42,7 @@ * swank-openmcl.lisp (swank-mop, function-name): Implement. (arglist): Implement for function objects. + 2004-09-12 Helmut Eller * swank.lisp (compile-file-for-emacs): Use with-buffer-syntax so From vqgmarumu at myown25.fsnet.co.uk Mon Sep 13 03:49:31 2004 From: vqgmarumu at myown25.fsnet.co.uk (Karyn Acevedo) Date: Sun, 12 Sep 2004 22:49:31 -0500 Subject: [slime-cvs] your meeting at 08-00 Message-ID: An HTML attachment was scrubbed... URL: From aruttenberg at common-lisp.net Mon Sep 13 05:35:15 2004 From: aruttenberg at common-lisp.net (Alan Ruttenberg) Date: Mon, 13 Sep 2004 07:35:15 +0200 Subject: [slime-cvs] CVS update: slime/metering.lisp Message-ID: Update of /project/slime/cvsroot/slime In directory common-lisp.net:/tmp/cvs-serv8458/slime Modified Files: metering.lisp Log Message: openmcl Date: Mon Sep 13 07:35:14 2004 Author: aruttenberg Index: slime/metering.lisp diff -u slime/metering.lisp:1.1 slime/metering.lisp:1.2 --- slime/metering.lisp:1.1 Wed Feb 18 08:25:38 2004 +++ slime/metering.lisp Mon Sep 13 07:35:14 2004 @@ -419,9 +419,9 @@ #+(and :excl :allegro-v4.0) (cltl1:provide "monitor") -#+(and :excl :allegro-version>= (version>= 4 1)) +#+(and :excl :allegro-version>= (version>= 4 1) :openmcl) (provide "monitor") -#+:mcl +#+(and :mcl (not :openmcl)) (ccl:provide "monitor") #+(and :cltl2 (not (or (and :excl (or :allegro-v4.0 (and :allegro-version>= From aruttenberg at common-lisp.net Mon Sep 13 05:36:28 2004 From: aruttenberg at common-lisp.net (Alan Ruttenberg) Date: Mon, 13 Sep 2004 07:36:28 +0200 Subject: [slime-cvs] CVS update: slime/slime.el Message-ID: Update of /project/slime/cvsroot/slime In directory common-lisp.net:/tmp/cvs-serv8482/slime Modified Files: slime.el Log Message: slime-goto-location-position: New location specifiers: (:method name specializers . qualifiers) all are strings. Looks for defxxx name then the qualifiers as words, in order then the specializers as words, in order (except for "T", which is optional). Pass the symbols names for specializers and qualifiers (no packages). Used by openmcl but might be useful for others (:text-anchored ) Got to position, then search for string, then move delta. To support upcoming source recording for openmcl debugging. Date: Mon Sep 13 07:36:27 2004 Author: aruttenberg Index: slime/slime.el diff -u slime/slime.el:1.398 slime/slime.el:1.399 --- slime/slime.el:1.398 Mon Sep 13 01:56:39 2004 +++ slime/slime.el Mon Sep 13 07:36:27 2004 @@ -3698,12 +3698,34 @@ (re-search-forward (format "[( \t]%s\\>\\(\\s \\|$\\)" name) nil t))) (goto-char (match-beginning 0))) + ;; Looks for a sequence of words (def method name qualifers specializers + ;; don't look for "T" since it isn't requires (arg without t) as class is taken as such. + ((:method name specializers . qualifiers) + (let ((case-fold-search t) + (name (regexp-quote name))) + (or + (and + (re-search-forward + (setq it (format "\\s *(def\\(\\s_\\|\\sw\\)*\\s +%s\\>%s%s" name + (apply 'concat (mapcan (lambda(el) (list ".+?\\<" el "\\>")) qualifiers)) + (apply 'concat (mapcan (lambda(el) (list ".+?\\<" el "\\>")) (remove "T" specializers))) + )) nil t) + (goto-char (match-beginning 0))) +; (slime-goto-location-position `(:function-name ,name)) + + ))) ((:source-path source-path start-position) (cond (start-position (goto-char start-position) (slime-forward-positioned-source-path source-path)) (t - (slime-forward-source-path source-path)))))) + (slime-forward-source-path source-path)))) + ;; Goes to "start" then looks for the anchor text, then moves delta from that position. + ((:text-anchored start text delta) + (goto-char start) + (slime-isearch text) + (forward-char delta)) + )) (defun slime-goto-source-location (location &optional noerror) "Move to the source location LOCATION. Several kinds of locations @@ -3719,7 +3741,9 @@ ::= (:position []) ; 1 based | (:line []) | (:function-name ) - | (:source-path ) " + | (:source-path ) + | (:text-anchored ) + | (:method . )" (destructure-case location ((:location buffer position hints) (slime-goto-location-buffer buffer) From aruttenberg at common-lisp.net Mon Sep 13 05:37:04 2004 From: aruttenberg at common-lisp.net (Alan Ruttenberg) Date: Mon, 13 Sep 2004 07:37:04 +0200 Subject: [slime-cvs] CVS update: slime/swank-loader.lisp Message-ID: Update of /project/slime/cvsroot/slime In directory common-lisp.net:/tmp/cvs-serv10692/slime Modified Files: swank-loader.lisp Log Message: load "metering.lisp" in openmcl Date: Mon Sep 13 07:37:03 2004 Author: aruttenberg Index: slime/swank-loader.lisp diff -u slime/swank-loader.lisp:1.33 slime/swank-loader.lisp:1.34 --- slime/swank-loader.lisp:1.33 Thu Sep 9 17:57:24 2004 +++ slime/swank-loader.lisp Mon Sep 13 07:37:03 2004 @@ -26,7 +26,7 @@ '("nregex") #+cmu '("swank-source-path-parser" "swank-cmucl") #+sbcl '("swank-sbcl" "swank-source-path-parser" "swank-gray") - #+openmcl '("swank-openmcl" "swank-gray") + #+openmcl '("metering" "swank-openmcl" "swank-gray") #+lispworks '("swank-lispworks" "swank-gray") #+allegro '("swank-allegro" "swank-gray") #+clisp '("xref" "metering" "swank-clisp" "swank-gray") From aruttenberg at common-lisp.net Mon Sep 13 05:39:06 2004 From: aruttenberg at common-lisp.net (Alan Ruttenberg) Date: Mon, 13 Sep 2004 07:39:06 +0200 Subject: [slime-cvs] CVS update: slime/swank-openmcl.lisp Message-ID: Update of /project/slime/cvsroot/slime In directory common-lisp.net:/tmp/cvs-serv12903/slime Modified Files: swank-openmcl.lisp Log Message: * slime.el slime-goto-location-position: New location specifiers: (:method name specializers . qualifiers) all are strings. Looks for defxxx name then the qualifiers as words, in order then the specializers as words, in order (except for "T", which is optional). Pass the symbols names for specializers and qualifiers (no packages). Used by openmcl but might be useful for others (:text-anchored ) Got to position, then search for string, then move delta. To support upcoming source recording for openmcl debugging. * swank-openmcl multiple changes: - fix support for *sldb-top* (formerly *swank-debugger-stack-frame*) Was not thread safe. Now (application-error), and (interrupt-thread) records the error pointer in a table associated with thread and map-backtrace picks up the appropriate pointer. *process-to-stack-top*, (grab-stack-top), (record-stack-top). - Other adjustments for changes to multiprocessing: remove (force-break-in-listener) no longer necessary since we use process-interrupt instead of ccl::*interactive-abort-process* Adjust break-in-sldb to do so for swank repl connections (abstraction breaking reference to swank::*connections*, but nicely via intern) - changes to (find-definitions) (function-source-location), addition of (maybe-method-location) (remove-filename-quoting). To support editing definitions of methods. To fix bug with pathnames with quoted characters (like "\\.swank.lisp"). To remove bogus source recording of l1-boot-3 in functions that didn't have a source file noted. - Implementation of xref functions: (xref-locations) uses xref implementation added to openmcl recently. Note that you have to (ccl::start-xref) for it to work for other than who-calls, and that xref information is not currently persisted in fasl files (I will release a patch for this soon) Backend functions (who-binds) (who-macroexpands) (who-references) (who-sets) (who-calls) (list-callees) (who-specializes) - Lifted profile backend functions from swank-clisp which use "metering.lisp" - (openmcl-set-debug-switches) turns on the various variables I. know about that have the lisp record extra debugging information(including starting xref). I suggest you call it. Should it be called by default? - (frame-arguments) use builtin ccl::frame-supplied-args since the current version was sometimes missing the first argument to the function. (I think this was when it was passed by register. If you don't want to lose it in the frame locals in backtrace, call (openmcl-set-debug-switches) specifically, set ccl::*ppc2-compiler-register-save-label* to t Date: Mon Sep 13 07:39:06 2004 Author: aruttenberg Index: slime/swank-openmcl.lisp diff -u slime/swank-openmcl.lisp:1.80 slime/swank-openmcl.lisp:1.81 --- slime/swank-openmcl.lisp:1.80 Mon Sep 13 01:56:39 2004 +++ slime/swank-openmcl.lisp Mon Sep 13 07:39:06 2004 @@ -65,6 +65,8 @@ ccl:stream-line-column ccl:stream-line-length)) +(require 'xref) + ;;; swank-mop (eval-when (:compile-toplevel :load-toplevel :execute) @@ -124,8 +126,6 @@ ;;; TCP Server -(defvar *swank-debugger-stack-frame* nil) - (defimplementation preferred-communication-style () :spawn) @@ -157,34 +157,14 @@ (defimplementation lisp-implementation-type-name () "openmcl") -(let ((ccl::*warn-if-redefine-kernel* nil)) - (defun ccl::force-break-in-listener (p) - (ccl::process-interrupt - p - #'(lambda () - (ccl::ignoring-without-interrupts - (let ((*swank-debugger-stack-frame* nil) - (previous-f nil)) - (block find-frame - (map-backtrace - #'(lambda(frame-number p context lfun pc) - (declare (ignore frame-number context pc)) - (when (eq previous-f 'ccl::%pascal-functions%) - (setq *swank-debugger-stack-frame* p) - (return-from find-frame)) - (setq previous-f (ccl::lfun-name lfun))))) - (restart-case (invoke-debugger - (make-condition 'simple-condition :format-control "")) - (continue () :report (lambda (stream) (write-string "Resume interrupted evaluation" stream)) t)) - )))))) - (defvar *break-in-sldb* t) (let ((ccl::*warn-if-redefine-kernel* nil)) (ccl::advise cl::break (if (and *break-in-sldb* - (eq ccl::*current-process* ccl::*interactive-abort-process*)) + (find ccl::*current-process* (symbol-value (intern "*CONNECTIONS*" 'swank)) + :key (intern "CONNECTION.REPL-THREAD" 'swank))) (apply 'break-in-sldb ccl::arglist) (:do-it)) :when :around :name sldb-break)) @@ -192,15 +172,14 @@ (let ((c (make-condition 'simple-condition :format-control (or string "Break") :format-arguments args))) - (let ((*swank-debugger-stack-frame* nil) - (previous-f nil) + (let ((previous-f nil) (previous-f2 nil)) (block find-frame (map-backtrace #'(lambda(frame-number p context lfun pc) (declare (ignore frame-number context pc)) (when (eq previous-f2 'break-in-sldb) - (setq *swank-debugger-stack-frame* p) + (record-stack-top p) (return-from find-frame)) (setq previous-f2 previous-f) (setq previous-f (ccl::lfun-name lfun))))) @@ -208,11 +187,29 @@ (continue () :report (lambda (stream) (write-string "Resume interrupted evaluation" stream)) t)) ))) -;;; Evaluation +; In previous version the code that recorded the function that had an +; error or which was interrupted was not thread safe. This code repairs that by +; associating the frame pointer with a process via the *process-to-stack-top* hash. + +(defvar *process-to-stack-top* (make-hash-table :test 'eql)) + +(defun record-stack-top (frame) + (setf (gethash (ccl::process-serial-number ccl::*current-process*) *process-to-stack-top* ) + frame)) + +(defun grab-stack-top () + (let ((psn (ccl::process-serial-number ccl::*current-process*))) + (ccl::without-interrupts + (prog1 + (gethash psn *process-to-stack-top*) + (setf (gethash psn *process-to-stack-top*) nil))))) (defmethod ccl::application-error :before (application condition error-pointer) (declare (ignore application condition)) - (setq *swank-debugger-stack-frame* error-pointer)) + (record-stack-top error-pointer) + nil) + +;;; Evaluation (defimplementation arglist ((fname symbol)) (ccl:arglist fname)) @@ -266,6 +263,67 @@ (*buffer-offset* nil)) (compile-file filename :load load-p)))) +(defimplementation frame-var-value (frame var) + (map-backtrace + #'(lambda(frame-number p context lfun pc) + (when (= frame frame-number) + (return-from frame-var-value + (multiple-value-bind (count vsp parent-vsp) + (ccl::count-values-in-frame p context) + (declare (ignore count)) + (ccl::nth-value-in-frame p var context lfun pc vsp parent-vsp))))))) + +(defun xref-locations (relation name &optional (inverse nil)) + (loop for xref in (if inverse + (ccl::get-relation relation name :wild :exhaustive t) + (ccl::get-relation relation :wild name :exhaustive t)) + for function = (ccl::xref-entry-name xref) + collect `((function ,function) ,(function-source-location (ccl::xref-entry-name xref))))) + +(defimplementation who-binds (name) + (xref-locations :binds name)) + +(defimplementation who-macroexpands (name) + (xref-locations :macro-calls name t)) + +(defimplementation who-references (name) + (remove-duplicates + (append (xref-locations :references name) + (xref-locations :sets name) + (xref-locations :binds name))) + :test 'equal) + +(defimplementation who-sets (name) + (xref-locations :sets name)) + +(defimplementation who-calls (name) + (remove-duplicates + (append + (xref-locations :direct-calls name) + (xref-locations :indirect-calls name) + (xref-locations :macro-calls name t)) + :test 'equal)) + +(defimplementation list-callees (name) + (remove-duplicates + (append + (xref-locations :direct-calls name t) + (xref-locations :macro-calls name nil)) + :test 'equal)) + +(defimplementation who-specializes (class) + (if (symbolp class) (setq class (find-class class))) + (remove-duplicates + (append (mapcar (lambda(m) + (let ((location (function-source-location (ccl::method-function m)))) + (if (eq (car location) :error) + (setq location nil )) + `((method ,(ccl::method-name m) ,(mapcar 'class-name (ccl::method-specializers m)) ,@(ccl::method-qualifiers m)) + ,location))) + (ccl::%class.direct-methods class)) + (mapcan 'who-specializes (ccl::%class-direct-subclasses class))) + :test 'equal)) + (defimplementation swank-compile-string (string &key buffer position directory) (declare (ignore directory)) (with-compilation-hooks () @@ -279,13 +337,48 @@ (delete-file binary-filename))) (delete-file filename)))) +;;; Profiling (alanr: lifted from swank-clisp) + +(defimplementation profile (fname) + (eval `(mon:monitor ,fname))) ;monitor is a macro + +(defimplementation profiled-functions () + mon:*monitored-functions*) + +(defimplementation unprofile (fname) + (eval `(mon:unmonitor ,fname))) ;unmonitor is a macro + +(defimplementation unprofile-all () + (mon:unmonitor)) + +(defimplementation profile-report () + (mon:report-monitoring)) + +(defimplementation profile-reset () + (mon:reset-all-monitoring)) + +(defimplementation profile-package (package callers-p methods) + (declare (ignore callers-p methods)) + (mon:monitor-all package)) + ;;; Debugging -(defvar *sldb-stack-top*) +(defun openmcl-set-debug-switches () + (setq ccl::*fasl-save-definitions* nil) + (setq ccl::*fasl-save-doc-strings* t) + (setq ccl::*fasl-save-local-symbols* t) + (setq ccl::*ppc2-compiler-register-save-label* t) + (setq ccl::*save-arglist-info* t) + (setq ccl::*save-definitions* nil) + (setq ccl::*save-doc-strings* t) + (setq ccl::*save-local-symbols* t) + (ccl::start-xref)) + +(defvar *sldb-stack-top* nil) (defimplementation call-with-debugging-environment (debugger-loop-fn) - (let* ((*sldb-stack-top* nil) - (*debugger-hook* nil) + (let* ((*debugger-hook* nil) + (*sldb-stack-top* (grab-stack-top)) (ccl::*signal-printing-errors* nil)) ; don't let error while printing error take us down (funcall debugger-loop-fn))) @@ -303,7 +396,7 @@ from frames START-FRAME-NUMBER to END-FRAME-NUMBER." (let ((context (backtrace-context)) (frame-number 0) - (top-stack-frame (or *swank-debugger-stack-frame* + (top-stack-frame (or *sldb-stack-top* (ccl::%get-frame-ptr)))) (do* ((p top-stack-frame (ccl::parent-frame p context)) (q (ccl::last-frame-ptr context))) @@ -317,29 +410,26 @@ (incf frame-number)))))) ;; May 13, 2004 alanr: use prin1 instead of princ so I see " around strings. Write ' in front of symbol names and lists. +;; Sept 6, 2004 alanr: use builtin ccl::frame-supplied-args (defun frame-arguments (p context lfun pc) "Returns a string representing the arguments of a frame." - (multiple-value-bind (count vsp parent-vsp) - (ccl::count-values-in-frame p nil) - (let (result) - (dotimes (i count) - (multiple-value-bind (var type name) - (ccl::nth-value-in-frame p i context lfun pc vsp parent-vsp) - (when name - (when (or (symbolp var) (listp var)) (setq var (list 'quote var))) - (cond ((equal type "required") - (push (prin1-to-string var) result)) - ((equal type "optional") - (push (prin1-to-string var) result)) - ((equal type "keyword") - (push (format nil "~S ~A" - (intern (symbol-name name) "KEYWORD") - (prin1-to-string var)) - result)))))) - (format nil "~{ ~A~}" (nreverse result))))) - - + (multiple-value-bind (args types names count nclosed) + (ccl::frame-supplied-args p lfun pc nil context) + (declare (ignore count nclosed)) + (let ((result nil)) + (loop for var in args + for type in types + for name in names + do + (when (or (symbolp var) (listp var)) (setq var (list 'quote var))) + (cond ((equal type "keyword") + (push (format nil "~S ~A" + (intern (symbol-name name) "KEYWORD") + (prin1-to-string var)) + result)) + (t (push (prin1-to-string var) result)))) + (format nil "~{ ~A~}" (nreverse result))))) ;; XXX should return something less stringy @@ -421,20 +511,40 @@ (defun canonicalize-location (file symbol) (etypecase file ((or string pathname) - (multiple-value-bind (truename c) (ignore-errors (truename file)) + (multiple-value-bind (truename c) (ignore-errors (namestring (truename file))) (cond (c (list :error (princ-to-string c))) - (t (make-location (list :file (namestring truename)) - (list :function-name (string symbol))))))))) + (t (make-location (list :file (remove-filename-quoting truename)) + (list :function-name (princ-to-string symbol))))))))) + +(defun remove-filename-quoting (string) + (if (search "\\" string) + (read-from-string (format nil "\"~a\"" string)) + string)) + +(defun maybe-method-location (type) + (when (typep type 'ccl::method) + `((method ,(ccl::method-name type) ,(mapcar 'class-name (ccl::method-specializers type)) ,@(ccl::method-qualifiers type)) + ,(function-source-location (ccl::method-function type))))) (defimplementation find-definitions (symbol) - (let ((info (ccl::get-source-files-with-types&classes symbol))) + (let* ((info (ccl::get-source-files-with-types&classes symbol))) (loop for (type . file) in info - collect (list (list type symbol) - (canonicalize-location file symbol))))) + when (not (equal "l1-boot-3" (pathname-name file))) ; alanr: This is a bug - there's nothing in there + collect (or (maybe-method-location type) + (list (list type symbol) + (canonicalize-location file symbol)))))) + (defun function-source-location (function) (multiple-value-bind (info name) (ccl::edit-definition-p function) (cond ((not info) (list :error "No source info available for ~A" function)) + ((typep (caar info) 'ccl::method) + `(:location + (:file ,(remove-filename-quoting (namestring (translate-logical-pathname (cdr (car info))) ))) + (:method ,(princ-to-string (ccl::method-name (caar info))) + ,(mapcar 'princ-to-string (mapcar 'class-name (ccl::method-specializers (caar info)))) + ,@(mapcar 'princ-to-string (ccl::method-qualifiers (caar info)))) + nil)) (t (canonicalize-location (cdr (first info)) name))))) (defimplementation frame-source-location-for-emacs (index) @@ -612,8 +722,22 @@ (defimplementation kill-thread (thread) (ccl:process-kill thread)) +;; September 5, 2004 alanr. record the frame interrupted (defimplementation interrupt-thread (thread fn) - (ccl:process-interrupt thread fn)) + (ccl:process-interrupt + thread + (lambda(&rest args) + (let ((previous-f nil)) + (block find-frame + (map-backtrace + #'(lambda(frame-number p context lfun pc) + (declare (ignore frame-number context pc)) + (when (eq previous-f 'ccl::%pascal-functions%) + (record-stack-top p) + (return-from find-frame)) + (setq previous-f (ccl::lfun-name lfun))))) + (apply fn args))))) + (defun mailbox (thread) (ccl:with-lock-grabbed (*known-processes-lock*) @@ -623,7 +747,11 @@ (setq *known-processes* (acons (ccl::process-serial-number thread) (list thread mailbox) - *known-processes*)) + (remove-if + (lambda(entry) + (string= (ccl::process-whostate (second entry)) "Exhausted")) + *known-processes*) + )) mailbox)))))) (defimplementation send (thread message) From aruttenberg at common-lisp.net Mon Sep 13 05:39:56 2004 From: aruttenberg at common-lisp.net (Alan Ruttenberg) Date: Mon, 13 Sep 2004 07:39:56 +0200 Subject: [slime-cvs] CVS update: slime/ChangeLog Message-ID: Update of /project/slime/cvsroot/slime In directory common-lisp.net:/tmp/cvs-serv12926/slime Modified Files: ChangeLog Log Message: Date: Mon Sep 13 07:39:56 2004 Author: aruttenberg Index: slime/ChangeLog diff -u slime/ChangeLog:1.519 slime/ChangeLog:1.520 --- slime/ChangeLog:1.519 Mon Sep 13 02:14:47 2004 +++ slime/ChangeLog Mon Sep 13 07:39:55 2004 @@ -1,3 +1,65 @@ +2004-09-13 Alan Ruttenberg + + * slime.el slime-goto-location-position: New location specifiers: + (:method name specializers . qualifiers) all are strings. Looks + for defxxx name then the qualifiers as words, in order then the + specializers as words, in order (except for "T", which is + optional). Pass the symbols names for specializers and qualifiers + (no packages). Used by openmcl but might be useful for others + (:text-anchored ) + Got to position, then search for string, then move delta. To + support upcoming source recording for openmcl debugging. + + * swank-openmcl multiple changes: - fix support for *sldb-top* + (formerly *swank-debugger-stack-frame*) Was not thread safe. Now + (application-error), and (interrupt-thread) records the error + pointer in a table associated with thread and map-backtrace picks + up the appropriate pointer. *process-to-stack-top*, + (grab-stack-top), (record-stack-top). + + - Other adjustments for changes to multiprocessing: remove + (force-break-in-listener) no longer necessary since we use + process-interrupt instead of ccl::*interactive-abort-process* + Adjust break-in-sldb to do so for swank repl connections + (abstraction breaking reference to swank::*connections*, but + nicely via intern) + + - changes to (find-definitions) (function-source-location), + addition of (maybe-method-location) (remove-filename-quoting). To support + editing definitions of methods. To fix bug with pathnames with + quoted characters (like "\\.swank.lisp"). To remove bogus source + recording of l1-boot-3 in functions that didn't have a source file + noted. + + - Implementation of xref functions: (xref-locations) uses xref + implementation added to openmcl recently. Note that you have to + (ccl::start-xref) for it to work for other than who-calls, and + that xref information is not currently persisted in fasl files (I + will release a patch for this soon) Backend functions (who-binds) + (who-macroexpands) (who-references) (who-sets) + (who-calls) (list-callees) (who-specializes) + + - Lifted profile backend functions from swank-clisp which use + "metering.lisp" + + - (openmcl-set-debug-switches) turns on the various variables I. + know about that have the lisp record extra debugging + information(including starting xref). I suggest you call + it. Should it be called by default? + + - (frame-arguments) use builtin ccl::frame-supplied-args since the + current version was sometimes missing the first argument to the + function. (I think this was when it was passed by register. If you + don't want to lose it in the frame locals in backtrace, call + (openmcl-set-debug-switches) specifically, set + ccl::*ppc2-compiler-register-save-label* to t + + - implement frame-var-value backend + + * metering.lisp: Minor changes to #+ #- to recognize openmcl + + * swank-loader.lisp: Load "metering.lisp" + 2004-09-13 Marco Baringer * swank.lisp (inspected-parts): Deal with unfinalized classes in From mbaringer at common-lisp.net Mon Sep 13 08:47:15 2004 From: mbaringer at common-lisp.net (Marco Baringer) Date: Mon, 13 Sep 2004 10:47:15 +0200 Subject: [slime-cvs] CVS update: slime/ChangeLog Message-ID: Update of /project/slime/cvsroot/slime In directory common-lisp.net:/tmp/cvs-serv32538 Modified Files: ChangeLog Log Message: Mention that Thomas Schilling implemented the allegro inspector. Date: Mon Sep 13 10:47:15 2004 Author: mbaringer Index: slime/ChangeLog diff -u slime/ChangeLog:1.520 slime/ChangeLog:1.521 --- slime/ChangeLog:1.520 Mon Sep 13 07:39:55 2004 +++ slime/ChangeLog Mon Sep 13 10:47:14 2004 @@ -97,7 +97,7 @@ (function-name): New backend function. * swank-allegro.lisp (swank-mop, slot-definition-documentation): - Implement. + Implement. (Patch from Thomas Schilling) * swank-sbcl.lisp (swank-mop, slot-definition-documentation, function-name): Implement. From %FROM_USER at dsoton.freeserve.co.uk Mon Sep 13 09:28:38 2004 From: %FROM_USER at dsoton.freeserve.co.uk (Cleo Hamilton) Date: Mon, 13 Sep 2004 11:28:38 +0200 Subject: [slime-cvs] meeting saturday at 04-00 Message-ID: <%MESSAGEID@tellurium> cry conscript between teletypewrite afterimage antigone tuba ferromagnetism caspian bremsstrahlung upraise destructor penumbra eastman cuprous mahoney hoopla madcap minneapolis commercial zodiacal -------------- next part -------------- An HTML attachment was scrubbed... URL: From %FROM_USER at shasta.com Mon Sep 13 13:32:33 2004 From: %FROM_USER at shasta.com (Alyssa Rice) Date: Mon, 13 Sep 2004 16:32:33 +0300 Subject: [slime-cvs] microsoft Office 2000 Premium Edition only $50 Message-ID: <%MESSAGEID@shasta.com> credible accept surgical homemake seethe eocene transpire cornerstone footpath tonight corrigendum complement injustice smuggle first earth visage declamation zircon comic carbonic pulverable assist boorish bursitis ultra baptismal -------------- next part -------------- An HTML attachment was scrubbed... URL: From ofujpo at asheville.com Mon Sep 13 14:54:01 2004 From: ofujpo at asheville.com (Bowers) Date: Mon, 13 Sep 2004 08:54:01 -0600 Subject: [slime-cvs] uncomfortable in his wet Message-ID: <000301c49999$32db85f0$e6e43f7e@wvgrubkiddm> An HTML attachment was scrubbed... URL: From ownozyjm at pearl-online.de Mon Sep 13 13:47:37 2004 From: ownozyjm at pearl-online.de (Darren Tomlinson) Date: Mon, 13 Sep 2004 19:47:37 +0600 Subject: [slime-cvs] appointment on monday at 21-00 Message-ID: An HTML attachment was scrubbed... URL: From mbaringer at common-lisp.net Mon Sep 13 16:42:36 2004 From: mbaringer at common-lisp.net (Marco Baringer) Date: Mon, 13 Sep 2004 18:42:36 +0200 Subject: [slime-cvs] CVS update: slime/swank.lisp slime/swank-sbcl.lisp slime/swank-openmcl.lisp slime/swank-cmucl.lisp slime/swank-backend.lisp slime/swank-allegro.lisp slime/ChangeLog Message-ID: Update of /project/slime/cvsroot/slime In directory common-lisp.net:/tmp/cvs-serv7014 Modified Files: swank.lisp swank-sbcl.lisp swank-openmcl.lisp swank-cmucl.lisp swank-backend.lisp swank-allegro.lisp ChangeLog Log Message: 2004-09-13 Marco Baringer * swank.lisp (inspected-parts): Added inspectors for pathnames, logical pathnames, standard-objects and numbers (float, ratio, integer and complex). * swank-backend.lisp: Define import-to-swank-mop. * swank-openmcl.lisp, swank-sbcl.lisp, swank-allegro.lisp: Don't define the import-to-swank-mop function (now defined in swank-backend.lisp). * swank-cmucl.lisp (swank-mop, function-name): Implement backend for inspector. (arglist): Add support for extracting arglists from function objects. (create-socket): Don't specify the host on PPC. Date: Mon Sep 13 18:42:32 2004 Author: mbaringer Index: slime/swank.lisp diff -u slime/swank.lisp:1.230 slime/swank.lisp:1.231 --- slime/swank.lisp:1.230 Mon Sep 13 02:14:47 2004 +++ slime/swank.lisp Mon Sep 13 18:42:31 2004 @@ -2451,16 +2451,14 @@ ;;;; Inspecting (defgeneric inspected-parts (object) - (:documentation " -Explan to emacs how to inspect OBJECT. + (:documentation "Explain to emacs how to inspect OBJECT. -The first value must be a string, it will be used as the -\"title\" of the inspector buffer. +Returns two values: a string which will be used as the title of +the inspector buffer and a list specifying how to render the +object for inspection. -The second value must be a list, this list will be rendered by -emacs in the inspector buffer. If the element of the list is a -string it will be rendered as is, otherwise it must be a list -like so: +Every elementi of the list must be either a string, which will be +inserted into the buffer as is, or a list of the form: (:value object &optional format) - Render an inspectable object. If format is provided it must be a string and will be @@ -2474,6 +2472,7 @@ NIL - do nothing.")) (defmethod inspected-parts ((o t)) + "Simply dump the output of CL:DESCRIBE." (values (format nil "~S" o) `("Don't know how to inspect the object, dumping output of CL:DESCIRBE:" (:newline) (:newline) @@ -2493,7 +2492,7 @@ (inspected-parts-of-simple-cons object))) (defun inspected-parts-of-simple-cons (cons) - (values (format nil "~S is a CONS." cons) + (values "A cons cell." `("Car: " (:value ,(car cons)) (:newline) "Cdr: " (:value ,(cdr cons))))) @@ -2523,7 +2522,7 @@ ,@(nreverse contents)))))) (defmethod inspected-parts ((ht hash-table)) - (values (format nil "The hash table ~S." ht) + (values "A hash table." `("Count: " (:value ,(hash-table-count ht)) (:newline) "Size: " (:value ,(hash-table-size ht)) @@ -2571,7 +2570,7 @@ collect '(:newline))))) (defmethod inspected-parts ((char character)) - (values (format nil "~C is a character." char) + (values "A character." `("Char code: " (:value ,(char-code char)) (:newline) "Lower cased: " (:value ,(char-downcase char)) @@ -2594,7 +2593,7 @@ `("It names the package " (:value ,(find-package symbol)) (:newline)))) (class (when (find-class symbol nil) `("It names the class " (:value ,(find-class symbol)))))) - (values (format nil "The symbol ~S." symbol) + (values "A symbol." `("It's name is: " (:value ,(symbol-name symbol)) (:newline) ;; check to see whether it is a global variable, a @@ -2628,19 +2627,44 @@ (princ (package-name (symbol-package symbol)) export-label) (princ "]" export-label)) ,(lambda () (export symbol (symbol-package symbol)))))) + "Property list: " (:value ,(symbol-plist symbol)) (:newline) , at package , at class)))) (defmethod inspected-parts ((f function)) - (values (format nil "The function ~S." f) + (values "A function." `("Name: " (:value ,(function-name f)) (:newline) - "It's argument list is: " ,(princ-to-string (arglist f)) (:newline) - "Documentation:" (:newline) - ,(documentation f t)))) + "It's argument list is: " ,(princ-to-string (arglist f)) + (:newline) + ,@(when (documentation f t) + `("Documentation:" (:newline) ,(documentation f t) (:newline)))))) + +(defmethod inspected-parts ((o standard-object)) + (values "An object." + `("Class: " (:value ,(class-of o)) + (:newline) + "Slots:" (:newline) + ,@(loop + with direct-slots = (swank-mop:class-direct-slots (class-of o)) + for slot in (swank-mop:class-slots (class-of o)) + for slot-def = (or (find-if (lambda (a) + ;; find the direct slot with the same as + ;; SLOT (an effective slot). + (eql (swank-mop:slot-definition-name a) + (swank-mop:slot-definition-name slot))) + direct-slots) + slot) + collect `(:value ,slot-def ,(princ-to-string (swank-mop:slot-definition-name slot-def))) + collect " = " + if (slot-boundp o (swank-mop:slot-definition-name slot-def)) + collect `(:value ,(slot-value o (swank-mop:slot-definition-name slot-def))) + else + collect "#" + collect '(:newline))))) (defmethod inspected-parts ((gf standard-generic-function)) - (values (format nil "The generic function ~S." gf) + (values "A generic function." `("Name: " (:value ,(swank-mop:generic-function-name gf)) (:newline) "It's argument list is: " ,(princ-to-string (swank-mop:generic-function-lambda-list gf)) (:newline) "Documentation: " (:newline) @@ -2666,7 +2690,7 @@ collect '(:newline))))) (defmethod inspected-parts ((method standard-method)) - (values (format nil "The method ~S." method) + (values "A method." `("Method defined on the generic function " (:value ,(swank-mop:method-generic-function method) ,(princ-to-string (swank-mop:generic-function-name @@ -2675,12 +2699,13 @@ "Documentation:" (:newline) ,(documentation method t) (:newline) "Lambda List: " (:value ,(swank-mop:method-lambda-list method)) (:newline) - "Specializers: " (:value ,(swank-mop:method-specializers method)) + "Specializers: " (:value ,(swank-mop:method-specializers method) + ,(princ-to-string (mapcar #'class-name (swank-mop:method-specializers method)))) (:newline) "Qualifiers: " (:value ,(swank-mop:method-qualifiers method))))) (defmethod inspected-parts ((class standard-class)) - (values (format nil "The class ~S." class) + (values "A class." `("Name: " (:value ,(class-name class)) (:newline) "Super classes: " ,@(common-seperated-spec (swank-mop:class-direct-superclasses class)) @@ -2715,7 +2740,7 @@ '"N/A (class not finalized)")))) (defmethod inspected-parts ((slot swank-mop:standard-slot-definition)) - (values (format nil "The slot ~S." slot) + (values "A slot." `("Name: " (:value ,(swank-mop:slot-definition-name slot)) (:newline) "Documentation:" (:newline) @@ -2742,7 +2767,7 @@ (push sym external-symbols))))) (setf internal-symbols (sort internal-symbols #'string-lessp) external-symbols (sort external-symbols #'string-lessp)) - (values (format nil "The package ~S." package) + (values "A package." `("Name: " (:value ,(package-name package)) (:newline) "Nick names: " ,@(common-seperated-spec (sort (package-nicknames package) #'string-lessp)) @@ -2770,6 +2795,88 @@ "0 shadowed symbols." `(:value ,(package-shadowing-symbols package) ,(format nil "~D shadowed symbols." (length (package-shadowing-symbols package))))))))) + +(defmethod inspected-parts ((pathname pathname)) + (values "A pathname." + `("Namestring: " (:value ,(namestring pathname)) + (:newline) + "Host: " (:value ,(pathname-host pathname)) + (:newline) + "Device: " (:value ,(pathname-device pathname)) + (:newline) + "Directory: " (:value ,(pathname-directory pathname)) + (:newline) + "Name: " (:value ,(pathname-name pathname)) + (:newline) + "Type: " (:value ,(pathname-type pathname)) + (:newline) + "Version: " (:value ,(pathname-version pathname)) + (:newline) + "Truename: " (:value ,(truename pathname))))) + +(defmethod inspected-parts ((pathname logical-pathname)) + (values "A logical pathname." + `("Namestring: " (:value ,(namestring pathname)) + (:newline) + "Physical pathname: " (:value ,(translate-logical-pathname pathname)) + (:newline) + "Host: " (:value ,(pathname-host pathname)) + " (" (:value ,(logical-pathname-translations (pathname-host pathname)) "other translations") ")" + (:newline) + "Directory: " (:value ,(pathname-directory pathname)) + (:newline) + "Name: " (:value ,(pathname-name pathname)) + (:newline) + "Type: " (:value ,(pathname-type pathname)) + (:newline) + "Version: " (:value ,(pathname-version pathname))))) + +(defmethod inspected-parts ((n number)) + (values "A number." `("Value: " ,(princ-to-string n)))) + +(defmethod inspected-parts ((i integer)) + (values "A number." + `("Value: " ,(princ-to-string i) + " == #x" ,(format nil "~X" i) + " == #o" ,(format nil "~O" i) + " == #b" ,(format nil "~B" i) + " == " ,(format nil "~E" i) + (:newline) + ,@(when (< -1 i char-code-limit) + `("Corresponding character: " (:value ,(code-char i)) (:newline))) + "Length: " (:value ,(integer-length i)) + (:newline) + "As time: " , (multiple-value-bind (sec min hour date month year daylight-p zone) + (decode-universal-time i) + (declare (ignore daylight-p zone)) + (format nil "~4,'0D-~2,'0D-~2,'0DT~2,'0D:~2,'0D:~2,'0DZ" + year month date hour min sec))))) + +(defmethod inspected-parts ((c complex)) + (values "A complex number." + `("Real part: " (:value ,(realpart c)) + (:newline) + "Imaginary part: " (:value ,(imagpart c))))) + +(defmethod inspected-parts ((r ratio)) + (values "A non-integer ratio." + `("Numerator: " (:value ,(numerator r)) + (:newline) + "Denominator: " (:value ,(denominator r)) + (:newline) + "As float: " (:value ,(float r))))) + +(defmethod inspected-parts ((f float)) + (multiple-value-bind (significand exponent sign) + (decode-float f) + (values "A floating point number." + `("Scientific: " ,(format nil "~E" f) + (:newline) + "Decoded: " (:value ,sign) " * " (:value ,significand) " * " (:value ,(float-radix f)) "^" (:value ,exponent) + (:newline) + "Digits: " (:value ,(float-digits f)) + (:newline) + "Precision: " (:value ,(float-precision f)))))) ;;;; Inspecting Index: slime/swank-sbcl.lisp diff -u slime/swank-sbcl.lisp:1.100 slime/swank-sbcl.lisp:1.101 --- slime/swank-sbcl.lisp:1.100 Mon Sep 13 01:56:39 2004 +++ slime/swank-sbcl.lisp Mon Sep 13 18:42:31 2004 @@ -37,65 +37,49 @@ ;;; swank-mop +(import-to-swank-mop + '( ;; classes + cl:standard-generic-function + sb-mop::standard-slot-definition + cl:method + cl:standard-class + ;; standard-class readers + sb-mop:class-default-initargs + sb-mop:class-direct-default-initargs + sb-mop:class-direct-slots + sb-mop:class-direct-subclasses + sb-mop:class-direct-superclasses + sb-mop:class-finalized-p + cl:class-name + sb-mop:class-precedence-list + sb-mop:class-prototype + sb-mop:class-slots + ;; generic function readers + sb-mop:generic-function-argument-precedence-order + sb-mop:generic-function-declarations + sb-mop:generic-function-lambda-list + sb-mop:generic-function-methods + sb-mop:generic-function-method-class + sb-mop:generic-function-method-combination + sb-mop:generic-function-name + ;; method readers + sb-mop:method-generic-function + sb-mop:method-function + sb-mop:method-lambda-list + sb-mop:method-specializers + sb-mop:method-qualifiers + ;; slot readers + sb-mop:slot-definition-allocation + sb-mop:slot-definition-initargs + sb-mop:slot-definition-initform + sb-mop:slot-definition-initfunction + sb-mop:slot-definition-name + sb-mop:slot-definition-type + sb-mop:slot-definition-readers + sb-mop:slot-definition-writers)) -(eval-when (:compile-toplevel :load-toplevel :execute) - (defun import-to-swank-mop (sym/sym-list) - (if (listp sym/sym-list) - (dolist (sym sym/sym-list) - (import-to-swank-mop sym)) - (let* ((sym sym/sym-list) - (swank-mop-sym (find-symbol (symbol-name sym) :swank-mop))) - ;; 1) "delete" the symbol form the :swank-mop package - (when swank-mop-sym - (unintern swank-mop-sym :swank-mop)) - (import sym :swank-mop) - (export sym :swank-mop)))) - - (import-to-swank-mop - '( ;; classes - cl:standard-generic-function - sb-mop::standard-slot-definition - cl:method - cl:standard-class - ;; standard-class readers - sb-mop:class-default-initargs - sb-mop:class-direct-default-initargs - sb-mop:class-direct-slots - sb-mop:class-direct-subclasses - sb-mop:class-direct-superclasses - sb-mop:class-finalized-p - cl:class-name - sb-mop:class-precedence-list - sb-mop:class-prototype - sb-mop:class-slots - ;; generic function readers - sb-mop:generic-function-argument-precedence-order - sb-mop:generic-function-declarations - sb-mop:generic-function-lambda-list - sb-mop:generic-function-methods - sb-mop:generic-function-method-class - sb-mop:generic-function-method-combination - sb-mop:generic-function-name - ;; method readers - sb-mop:method-generic-function - sb-mop:method-function - sb-mop:method-lambda-list - sb-mop:method-specializers - sb-mop:method-qualifiers - ;; slot readers - sb-mop:slot-definition-allocation - sb-mop:slot-definition-initargs - sb-mop:slot-definition-initform - sb-mop:slot-definition-initfunction - sb-mop:slot-definition-name - sb-mop:slot-definition-type - sb-mop:slot-definition-readers - sb-mop:slot-definition-writers)) - - (defun swank-mop:slot-definition-documentation (slot) - (sb-pcl::documentation slot t)) - - ) +(defun swank-mop:slot-definition-documentation (slot) + (sb-pcl::documentation slot t)) ;;; TCP Server Index: slime/swank-openmcl.lisp diff -u slime/swank-openmcl.lisp:1.81 slime/swank-openmcl.lisp:1.82 --- slime/swank-openmcl.lisp:1.81 Mon Sep 13 07:39:06 2004 +++ slime/swank-openmcl.lisp Mon Sep 13 18:42:31 2004 @@ -69,60 +69,47 @@ ;;; swank-mop -(eval-when (:compile-toplevel :load-toplevel :execute) - (defun import-to-swank-mop (sym/sym-list) - (if (listp sym/sym-list) - (dolist (sym sym/sym-list) - (import-to-swank-mop sym)) - (let* ((sym sym/sym-list) - (swank-mop-sym (find-symbol (symbol-name sym) :swank-mop))) - ;; 1) "delete" the symbol form the :swank-mop package - (when swank-mop-sym - (unintern swank-mop-sym :swank-mop)) - (import sym :swank-mop) - (export sym :swank-mop)))) - - (import-to-swank-mop - '( ;; classes - cl:standard-generic-function - ccl::standard-slot-definition - cl:method - cl:standard-class - ;; standard-class readers - openmcl-mop:class-default-initargs - openmcl-mop:class-direct-default-initargs - openmcl-mop:class-direct-slots - openmcl-mop:class-direct-subclasses - openmcl-mop:class-direct-superclasses - openmcl-mop:class-finalized-p - cl:class-name - openmcl-mop:class-precedence-list - openmcl-mop:class-prototype - openmcl-mop:class-slots - ;; generic function readers - openmcl-mop:generic-function-argument-precedence-order - openmcl-mop:generic-function-declarations - openmcl-mop:generic-function-lambda-list - openmcl-mop:generic-function-methods - openmcl-mop:generic-function-method-class - openmcl-mop:generic-function-method-combination - openmcl-mop:generic-function-name - ;; method readers - openmcl-mop:method-generic-function - openmcl-mop:method-function - openmcl-mop:method-lambda-list - openmcl-mop:method-specializers - openmcl-mop:method-qualifiers - ;; slot readers - openmcl-mop:slot-definition-allocation - ccl::slot-definition-documentation - openmcl-mop:slot-definition-initargs - openmcl-mop:slot-definition-initform - openmcl-mop:slot-definition-initfunction - openmcl-mop:slot-definition-name - openmcl-mop:slot-definition-type - openmcl-mop:slot-definition-readers - openmcl-mop:slot-definition-writers))) +(import-to-swank-mop + '( ;; classes + cl:standard-generic-function + ccl::standard-slot-definition + cl:method + cl:standard-class + ;; standard-class readers + openmcl-mop:class-default-initargs + openmcl-mop:class-direct-default-initargs + openmcl-mop:class-direct-slots + openmcl-mop:class-direct-subclasses + openmcl-mop:class-direct-superclasses + openmcl-mop:class-finalized-p + cl:class-name + openmcl-mop:class-precedence-list + openmcl-mop:class-prototype + openmcl-mop:class-slots + ;; generic function readers + openmcl-mop:generic-function-argument-precedence-order + openmcl-mop:generic-function-declarations + openmcl-mop:generic-function-lambda-list + openmcl-mop:generic-function-methods + openmcl-mop:generic-function-method-class + openmcl-mop:generic-function-method-combination + openmcl-mop:generic-function-name + ;; method readers + openmcl-mop:method-generic-function + openmcl-mop:method-function + openmcl-mop:method-lambda-list + openmcl-mop:method-specializers + openmcl-mop:method-qualifiers + ;; slot readers + openmcl-mop:slot-definition-allocation + ccl::slot-definition-documentation + openmcl-mop:slot-definition-initargs + openmcl-mop:slot-definition-initform + openmcl-mop:slot-definition-initfunction + openmcl-mop:slot-definition-name + openmcl-mop:slot-definition-type + openmcl-mop:slot-definition-readers + openmcl-mop:slot-definition-writers)) ;;; TCP Server Index: slime/swank-cmucl.lisp diff -u slime/swank-cmucl.lisp:1.114 slime/swank-cmucl.lisp:1.115 --- slime/swank-cmucl.lisp:1.114 Fri Sep 3 23:08:51 2004 +++ slime/swank-cmucl.lisp Mon Sep 13 18:42:31 2004 @@ -17,6 +17,50 @@ ;;; promptly delete them from here. It is enough to be compatible with ;;; the latest release. +(import-to-swank-mop + '( ;; classes + cl:standard-generic-function + pcl:standard-slot-definition + cl:method + cl:standard-class + ;; standard-class readers + pcl:class-default-initargs + pcl:class-direct-default-initargs + pcl:class-direct-slots + pcl:class-direct-subclasses + pcl:class-direct-superclasses + pcl:class-finalized-p + cl:class-name + pcl:class-precedence-list + pcl:class-prototype + pcl:class-slots + ;; generic function readers + pcl:generic-function-argument-precedence-order + pcl:generic-function-declarations + pcl:generic-function-lambda-list + pcl:generic-function-methods + pcl:generic-function-method-class + pcl:generic-function-method-combination + pcl:generic-function-name + ;; method readers + pcl:method-generic-function + pcl:method-function + pcl:method-lambda-list + pcl:method-specializers + pcl:method-qualifiers + ;; slot readers + pcl:slot-definition-allocation + pcl:slot-definition-initargs + pcl:slot-definition-initform + pcl:slot-definition-initfunction + pcl:slot-definition-name + pcl:slot-definition-type + pcl:slot-definition-readers + pcl:slot-definition-writers)) + +(defun swank-mop:slot-definition-documentation (slot) + (documentation slot t)) + (in-package :lisp) ;;; `READ-SEQUENCE' with large sequences has problems in 18e. This new @@ -72,9 +116,10 @@ :sigio) (defimplementation create-socket (host port) + #+ppc (declare (ignore host)) (ext:create-inet-listener port :stream :reuse-address t - :host (resolve-hostname host))) + #-ppc :host #-ppc (resolve-hostname host))) (defimplementation local-port (socket) (nth-value 1 (ext::get-socket-host-and-port (socket-fd socket)))) @@ -1282,27 +1327,39 @@ ;;;;; Argument lists -(defimplementation arglist (symbol) - (let* ((fun (or (macro-function symbol) - (symbol-function symbol))) - (arglist - (cond ((eval:interpreted-function-p fun) - (eval:interpreted-function-arglist fun)) - ((pcl::generic-function-p fun) - (pcl:generic-function-lambda-list fun)) - ((c::byte-function-or-closure-p fun) - (byte-code-function-arglist fun)) - ((kernel:%function-arglist (kernel:%function-self fun)) - (handler-case (read-arglist fun) - (error () :not-available))) - ;; this should work both for compiled-debug-function - ;; and for interpreted-debug-function - (t - (handler-case (debug-function-arglist - (di::function-debug-function fun)) - (di:unhandled-condition () :not-available)))))) +(defimplementation arglist ((name symbol)) + (arglist (or (macro-function name) + (symbol-function name) + (error "~S does not name a known function.")))) + +(defimplementation arglist ((fun function)) + (let ((arglist + (cond ((eval:interpreted-function-p fun) + (eval:interpreted-function-arglist fun)) + ((pcl::generic-function-p fun) + (pcl:generic-function-lambda-list fun)) + ((c::byte-function-or-closure-p fun) + (byte-code-function-arglist fun)) + ((kernel:%function-arglist (kernel:%function-self fun)) + (handler-case (read-arglist fun) + (error () :not-available))) + ;; this should work both for compiled-debug-function + ;; and for interpreted-debug-function + (t + (handler-case (debug-function-arglist + (di::function-debug-function fun)) + (di:unhandled-condition () :not-available)))))) (check-type arglist (or list (member :not-available))) arglist)) + +(defimplementation function-name (function) + (cond ((eval:interpreted-function-p function) + (eval:interpreted-function-name function)) + ((pcl::generic-function-p function) + (pcl::generic-function-name function)) + ((c::byte-function-or-closure-p function) + (c::byte-function-name function)) + (t (kernel:%function-name (kernel:%function-self function))))) ;;; A simple case: the arglist is available as a string that we can ;;; `read'. Index: slime/swank-backend.lisp diff -u slime/swank-backend.lisp:1.65 slime/swank-backend.lisp:1.66 --- slime/swank-backend.lisp:1.65 Mon Sep 13 01:56:39 2004 +++ slime/swank-backend.lisp Mon Sep 13 18:42:31 2004 @@ -72,6 +72,14 @@ #:slot-definition-readers #:slot-definition-writers)) +(defun swank-backend::import-to-swank-mop (symbol-list) + (dolist (sym symbol-list) + (let* ((swank-mop-sym (find-symbol (symbol-name sym) :swank-mop))) + (when swank-mop-sym + (unintern swank-mop-sym :swank-mop)) + (import sym :swank-mop) + (export sym :swank-mop)))) + (in-package :swank-backend) Index: slime/swank-allegro.lisp diff -u slime/swank-allegro.lisp:1.53 slime/swank-allegro.lisp:1.54 --- slime/swank-allegro.lisp:1.53 Mon Sep 13 01:56:39 2004 +++ slime/swank-allegro.lisp Mon Sep 13 18:42:31 2004 @@ -29,68 +29,50 @@ ;;; swank-mop -(eval-when (:compile-toplevel :load-toplevel :execute) - ;; Copied from swank-sbcl.lisp - ;; not sure if we still want a list of lists - ;; also not sure if we need to re-import too - (defun import-to-swank-mop (sym/sym-list) - (if (listp sym/sym-list) - (dolist (sym sym/sym-list) - (import-to-swank-mop sym)) - (let* ((sym sym/sym-list) - (swank-mop-sym (find-symbol (symbol-name sym) :swank-mop))) - ;; 1) "delete" the symbol form the :swank-mop package - (when swank-mop-sym - (unintern swank-mop-sym :swank-mop)) - (import sym :swank-mop) - (export sym :swank-mop)))) - - ;; maybe better change MOP to ACLMOP ? - (import-to-swank-mop - '( ;; classes - cl:standard-generic-function - mop::standard-slot-definition - cl:method - cl:standard-class - ;; standard-class readers - mop:class-default-initargs - mop:class-direct-default-initargs - mop:class-direct-slots - mop:class-direct-subclasses - mop:class-direct-superclasses - mop:class-finalized-p - cl:class-name - mop:class-precedence-list - mop:class-prototype - mop:class-slots - ;; generic function readers - mop:generic-function-argument-precedence-order - mop:generic-function-declarations - mop:generic-function-lambda-list - mop:generic-function-methods - mop:generic-function-method-class - mop:generic-function-method-combination - mop:generic-function-name - ;; method readers - mop:method-generic-function - mop:method-function - mop:method-lambda-list - mop:method-specializers - excl::method-qualifiers - ;; slot readers - mop:slot-definition-allocation - mop:slot-definition-initargs - mop:slot-definition-initform - mop:slot-definition-initfunction - mop:slot-definition-name - mop:slot-definition-type - mop:slot-definition-readers - mop:slot-definition-writers)) - - (defun swank-mop:slot-definition-documentation (slot) - (documentation slot)) - ) +;; maybe better change MOP to ACLMOP ? +(import-to-swank-mop + '( ;; classes + cl:standard-generic-function + mop::standard-slot-definition + cl:method + cl:standard-class + ;; standard-class readers + mop:class-default-initargs + mop:class-direct-default-initargs + mop:class-direct-slots + mop:class-direct-subclasses + mop:class-direct-superclasses + mop:class-finalized-p + cl:class-name + mop:class-precedence-list + mop:class-prototype + mop:class-slots + ;; generic function readers + mop:generic-function-argument-precedence-order + mop:generic-function-declarations + mop:generic-function-lambda-list + mop:generic-function-methods + mop:generic-function-method-class + mop:generic-function-method-combination + mop:generic-function-name + ;; method readers + mop:method-generic-function + mop:method-function + mop:method-lambda-list + mop:method-specializers + excl::method-qualifiers + ;; slot readers + mop:slot-definition-allocation + mop:slot-definition-initargs + mop:slot-definition-initform + mop:slot-definition-initfunction + mop:slot-definition-name + mop:slot-definition-type + mop:slot-definition-readers + mop:slot-definition-writers)) +(defun swank-mop:slot-definition-documentation (slot) + (documentation slot)) ;;;; TCP Server Index: slime/ChangeLog diff -u slime/ChangeLog:1.521 slime/ChangeLog:1.522 --- slime/ChangeLog:1.521 Mon Sep 13 10:47:14 2004 +++ slime/ChangeLog Mon Sep 13 18:42:31 2004 @@ -1,3 +1,21 @@ +2004-09-13 Marco Baringer + + * swank.lisp (inspected-parts): Added inspectors for pathnames, + logical pathnames, standard-objects and numbers (float, ratio, + integer and complex). + + * swank-backend.lisp: Define import-to-swank-mop. + + * swank-openmcl.lisp, swank-sbcl.lisp, swank-allegro.lisp: Don't + define the import-to-swank-mop function (now defined in + swank-backend.lisp). + + * swank-cmucl.lisp (swank-mop, function-name): Implement backend + for inspector. + (arglist): Add support for extracting arglists from function + objects. + (create-socket): Don't specify the host on PPC. + 2004-09-13 Alan Ruttenberg * slime.el slime-goto-location-position: New location specifiers: From msimmons at common-lisp.net Mon Sep 13 19:09:16 2004 From: msimmons at common-lisp.net (Martin Simmons) Date: Mon, 13 Sep 2004 21:09:16 +0200 Subject: [slime-cvs] CVS update: slime/swank-lispworks.lisp Message-ID: Update of /project/slime/cvsroot/slime In directory common-lisp.net:/tmp/cvs-serv14875 Modified Files: swank-lispworks.lisp Log Message: Set up the swank-mop package. Implement swank-mop:slot-definition-documentation and function-name. Date: Mon Sep 13 21:09:15 2004 Author: msimmons Index: slime/swank-lispworks.lisp diff -u slime/swank-lispworks.lisp:1.56 slime/swank-lispworks.lisp:1.57 --- slime/swank-lispworks.lisp:1.56 Wed Sep 8 18:08:26 2004 +++ slime/swank-lispworks.lisp Mon Sep 13 21:09:15 2004 @@ -25,6 +25,50 @@ stream:stream-line-column )) +(import-to-swank-mop + '( ;; classes + cl:standard-generic-function + clos:standard-slot-definition + cl:method + cl:standard-class + ;; standard-class readers + clos:class-default-initargs + clos:class-direct-default-initargs + clos:class-direct-slots + clos:class-direct-subclasses + clos:class-direct-superclasses + clos:class-finalized-p + cl:class-name + clos:class-precedence-list + clos:class-prototype + clos:class-slots + ;; generic function readers + clos:generic-function-argument-precedence-order + clos:generic-function-declarations + clos:generic-function-lambda-list + clos:generic-function-methods + clos:generic-function-method-class + clos:generic-function-method-combination + clos:generic-function-name + ;; method readers + clos:method-generic-function + clos:method-function + clos:method-lambda-list + clos:method-specializers + clos:method-qualifiers + ;; slot readers + clos:slot-definition-allocation + clos:slot-definition-initargs + clos:slot-definition-initform + clos:slot-definition-initfunction + clos:slot-definition-name + clos:slot-definition-type + clos:slot-definition-readers + clos:slot-definition-writers)) + +(defun swank-mop:slot-definition-documentation (slot) + (documentation slot t)) + (when (fboundp 'dspec::define-dspec-alias) (dspec::define-dspec-alias defimplementation (name args &rest body) `(defmethod ,name ,args , at body))) @@ -111,13 +155,16 @@ ;;;; Documentation -(defimplementation arglist (symbol) - (let ((arglist (lw:function-lambda-list symbol))) +(defimplementation arglist (symbol-or-function) + (let ((arglist (lw:function-lambda-list symbol-or-function))) (etypecase arglist ((member :dont-know) :not-available) (list arglist)))) + +(defimplementation function-name (function) + (nth-value 2 (function-lambda-expression function))) (defimplementation macroexpand-all (form) (walker:walk-form form)) From msimmons at common-lisp.net Mon Sep 13 19:13:00 2004 From: msimmons at common-lisp.net (Martin Simmons) Date: Mon, 13 Sep 2004 21:13:00 +0200 Subject: [slime-cvs] CVS update: slime/ChangeLog Message-ID: Update of /project/slime/cvsroot/slime In directory common-lisp.net:/tmp/cvs-serv15007 Modified Files: ChangeLog Log Message: Date: Mon Sep 13 21:13:00 2004 Author: msimmons Index: slime/ChangeLog diff -u slime/ChangeLog:1.522 slime/ChangeLog:1.523 --- slime/ChangeLog:1.522 Mon Sep 13 18:42:31 2004 +++ slime/ChangeLog Mon Sep 13 21:12:59 2004 @@ -1,3 +1,8 @@ +2004-09-09 Martin Simmons + + * swank-lispworks.lisp: Set up the swank-mop package. Implement + swank-mop:slot-definition-documentation and function-name. + 2004-09-13 Marco Baringer * swank.lisp (inspected-parts): Added inspectors for pathnames, From heller at common-lisp.net Mon Sep 13 21:36:13 2004 From: heller at common-lisp.net (Helmut Eller) Date: Mon, 13 Sep 2004 23:36:13 +0200 Subject: [slime-cvs] CVS update: slime/swank.lisp Message-ID: Update of /project/slime/cvsroot/slime In directory common-lisp.net:/tmp/cvs-serv24950 Modified Files: swank.lisp Log Message: (intern-catch-tag): New function. (read-user-input-from-emacs, take-input): Use it. (define-special): Set the documentation for the 'variable not for the 'symbol. Date: Mon Sep 13 23:36:13 2004 Author: heller Index: slime/swank.lisp diff -u slime/swank.lisp:1.231 slime/swank.lisp:1.232 --- slime/swank.lisp:1.231 Mon Sep 13 18:42:31 2004 +++ slime/swank.lisp Mon Sep 13 23:36:13 2004 @@ -871,6 +871,10 @@ (defvar *read-input-catch-tag* 0) +(defun intern-catch-tag (tag) + ;; fixnums aren't eq in ABCL, so we use intern to create tags + (intern (format nil "~D" tag) :swank)) + (defun read-user-input-from-emacs () (let ((*read-input-catch-tag* (1+ *read-input-catch-tag*))) (force-output) @@ -878,7 +882,7 @@ ,*read-input-catch-tag*)) (let ((ok nil)) (unwind-protect - (prog1 (catch *read-input-catch-tag* + (prog1 (catch (intern-catch-tag *read-input-catch-tag*) (loop (read-from-emacs))) (setq ok t)) (unless ok @@ -887,7 +891,7 @@ (defslimefun take-input (tag input) "Return the string INPUT to the continuation TAG." - (throw tag input)) + (throw (intern-catch-tag tag) input)) (defslimefun connection-info () "Return a list of the form: @@ -902,10 +906,10 @@ (defmacro define-special (name doc) "Define a special variable NAME with doc string DOC. -This is like defvar, but NAME will not initialized." +This is like defvar, but NAME will not be initialized." `(progn (defvar ,name) - (setf (documentation ',name 'symbol) ',doc))) + (setf (documentation ',name 'variable) ',doc))) (define-special *buffer-package* "Package corresponding to slime-buffer-package. From heller at common-lisp.net Mon Sep 13 21:45:29 2004 From: heller at common-lisp.net (Helmut Eller) Date: Mon, 13 Sep 2004 23:45:29 +0200 Subject: [slime-cvs] CVS update: slime/ChangeLog Message-ID: Update of /project/slime/cvsroot/slime In directory common-lisp.net:/tmp/cvs-serv27684 Modified Files: ChangeLog Log Message: *** empty log message *** Date: Mon Sep 13 23:45:27 2004 Author: heller Index: slime/ChangeLog diff -u slime/ChangeLog:1.523 slime/ChangeLog:1.524 --- slime/ChangeLog:1.523 Mon Sep 13 21:12:59 2004 +++ slime/ChangeLog Mon Sep 13 23:45:27 2004 @@ -1,3 +1,13 @@ +2004-09-13 Helmut Eller + + * swank.lisp (intern-catch-tag): New function. + (read-user-input-from-emacs, take-input): Use it. + +2004-09-13 John Paul Wallington + + * swank.lisp (define-special): Make the doc-type `variable' + rather than `symbol'. Don't quote `doc'. Doc fix. + 2004-09-09 Martin Simmons * swank-lispworks.lisp: Set up the swank-mop package. Implement From asimon at common-lisp.net Mon Sep 13 23:11:38 2004 From: asimon at common-lisp.net (Andras Simon) Date: Tue, 14 Sep 2004 01:11:38 +0200 Subject: [slime-cvs] CVS update: slime/swank-abcl.lisp Message-ID: Update of /project/slime/cvsroot/slime In directory common-lisp.net:/tmp/cvs-serv20004 Modified Files: swank-abcl.lisp Log Message: Minimal swank-mop support just so that slime/abcl can be compiled and loaded. Date: Tue Sep 14 01:11:38 2004 Author: asimon Index: slime/swank-abcl.lisp diff -u slime/swank-abcl.lisp:1.11 slime/swank-abcl.lisp:1.12 --- slime/swank-abcl.lisp:1.11 Fri Aug 27 22:27:19 2004 +++ slime/swank-abcl.lisp Tue Sep 14 01:11:37 2004 @@ -30,6 +30,52 @@ gs:stream-read-char-no-hang )) +;;; swank-mop +(defclass standard-slot-definition ()()) + +(import-to-swank-mop + '( ;; classes + cl:standard-generic-function +; ccl::standard-slot-definition + standard-slot-definition ;;dummy + cl:method + cl:standard-class + ;; standard-class readers + sys::class-default-initargs + sys::class-direct-default-initargs + sys::class-direct-slots + sys::class-direct-subclasses + sys::class-direct-superclasses +; openmcl-mop:class-finalized-p + cl:class-name + sys::class-precedence-list +; openmcl-mop:class-prototype + sys::class-slots + ;; generic function readers + sys::generic-function-argument-precedence-order +; openmcl-mop:generic-function-declarations + sys::generic-function-lambda-list + sys::generic-function-methods + sys::generic-function-method-class + sys::generic-function-method-combination + sys::generic-function-name + ;; method readers + sys::method-generic-function + sys::method-function + sys::method-lambda-list + sys::method-specializers + sys::method-qualifiers + ;; slot readers + sys::slot-definition-allocation +; ccl::slot-definition-documentation + sys::slot-definition-initargs + sys::slot-definition-initform + sys::slot-definition-initfunction + sys::slot-definition-name +; openmcl-mop:slot-definition-type + sys::slot-definition-readers + sys::slot-definition-writers)) + ;;;; TCP Server @@ -367,3 +413,4 @@ (defimplementation quit-lisp () (ext:exit)) + From Taria_Laskey at excite.com Tue Sep 14 08:04:53 2004 From: Taria_Laskey at excite.com (Mickel Mayfield) Date: Tue, 14 Sep 2004 12:04:53 +0400 Subject: [slime-cvs] Fwd: please Message-ID: An HTML attachment was scrubbed... URL: From mbaringer at common-lisp.net Tue Sep 14 07:48:51 2004 From: mbaringer at common-lisp.net (Marco Baringer) Date: Tue, 14 Sep 2004 09:48:51 +0200 Subject: [slime-cvs] CVS update: slime/swank-allegro.lisp slime/ChangeLog Message-ID: Update of /project/slime/cvsroot/slime In directory common-lisp.net:/tmp/cvs-serv7110 Modified Files: swank-allegro.lisp ChangeLog Log Message: 2004-09-14 Thomas Schilling * swank-allegro.lisp (inspected-parts): Implement inspector for structs. Date: Tue Sep 14 09:48:50 2004 Author: mbaringer Index: slime/swank-allegro.lisp diff -u slime/swank-allegro.lisp:1.54 slime/swank-allegro.lisp:1.55 --- slime/swank-allegro.lisp:1.54 Mon Sep 13 18:42:31 2004 +++ slime/swank-allegro.lisp Tue Sep 14 09:48:50 2004 @@ -421,6 +421,100 @@ (make-unbound-slot-filler))))) slots)))) +;; duplicated from swank.lisp in order to avoid package dependencies +(defun common-seperated-spec (list &optional (callback (lambda (v) `(:value ,v)))) + (butlast + (loop + for i in list + collect (funcall callback i) + collect ", "))) + +;; AllegroCL doesn't support (documentation t) +;; so we get the symbol and then its doc +(defun function-documentation (obj) + (documentation (excl::external-fn_symdef obj) 'function)) + +(defmethod inspected-parts ((f function)) + (values (format nil "The function ~S." f) + `("Name: " (:value ,(function-name f)) (:newline) + "It's argument list is: " ,(princ-to-string (arglist f)) (:newline) + "Documentation:" (:newline) + ,(function-documentation f)))) + +(defmethod inspected-parts ((class structure-class)) + (values "A structure class." + `("Name: " (:value ,(class-name class)) + (:newline) + "Super classes: " ,@(common-seperated-spec (swank-mop:class-direct-superclasses class)) + (:newline) + "Direct Slots: " ,@(common-seperated-spec (swank-mop:class-direct-slots class) + (lambda (slot) + `(:value ,slot ,(princ-to-string + (swank-mop:slot-definition-name slot))))) + (:newline) + "Effective Slots: " ,@(if (swank-mop:class-finalized-p class) + (common-seperated-spec (swank-mop:class-slots class) + (lambda (slot) + `(:value ,slot ,(princ-to-string + (swank-mop:slot-definition-name slot))))) + '("N/A (class not finalized)")) + (:newline) + "Documentation:" (:newline) + ,@(when (documentation class t) + `(,(documentation class t) (:newline))) + "Sub classes: " ,@(common-seperated-spec (swank-mop:class-direct-subclasses class) + (lambda (sub) + `(:value ,sub ,(princ-to-string (class-name sub))))) + (:newline) + "Precedence List: " ,@(if (swank-mop:class-finalized-p class) + (common-seperated-spec (swank-mop:class-precedence-list class) + (lambda (class) + `(:value ,class ,(princ-to-string (class-name class))))) + '("N/A (class not finalized)")) + (:newline) + "Prototype: " ,(if (swank-mop:class-finalized-p class) + `(:value ,(swank-mop:class-prototype class)) + '"N/A (class not finalized)")))) + +(defmethod inspected-parts ((slot excl::structure-slot-definition)) + (values "A structure slot." + `("Name: " (:value ,(mop:slot-definition-name slot)) + (:newline) + "Documentation:" (:newline) + ,@(when (documentation slot) + `((:value ,(documentation slot)) (:newline))) + "Initform: " ,(if (swank-mop:slot-definition-initform slot) + `(:value ,(swank-mop:slot-definition-initform slot)) + "#") (:newline) + "Type: " ,(if (swank-mop:slot-definition-type slot) + `(:value ,(swank-mop:slot-definition-type slot)) + "#") (:newline) + "Allocation: " (:value ,(excl::slotd-allocation slot)) (:newline) + "Read-only: " (:value ,(excl::slotd-read-only slot)) (:newline)))) + +(defmethod inspected-parts ((o structure-object)) + (values "An structure object." + `("Structure class: " (:value ,(class-of o)) + (:newline) + "Slots:" (:newline) + ,@(loop + with direct-slots = (swank-mop:class-direct-slots (class-of o)) + for slot in (swank-mop:class-slots (class-of o)) + for slot-def = (or (find-if (lambda (a) + ;; find the direct slot with the same as + ;; SLOT (an effective slot). + (eql (swank-mop:slot-definition-name a) + (swank-mop:slot-definition-name slot))) + direct-slots) + slot) + collect `(:value ,slot-def ,(princ-to-string (swank-mop:slot-definition-name slot-def))) + collect " = " + if (slot-boundp o (swank-mop:slot-definition-name slot-def)) + collect `(:value ,(slot-value o (swank-mop:slot-definition-name slot-def))) + else + collect "#" + collect '(:newline))))) + ;;;; Multithreading (defimplementation startup-multiprocessing () Index: slime/ChangeLog diff -u slime/ChangeLog:1.524 slime/ChangeLog:1.525 --- slime/ChangeLog:1.524 Mon Sep 13 23:45:27 2004 +++ slime/ChangeLog Tue Sep 14 09:48:50 2004 @@ -1,3 +1,8 @@ +2004-09-14 Thomas Schilling + + * swank-allegro.lisp (inspected-parts): Implement inspector for + structs. + 2004-09-13 Helmut Eller * swank.lisp (intern-catch-tag): New function. From dqwsfpivly at zipmail.com Tue Sep 14 08:54:46 2004 From: dqwsfpivly at zipmail.com (Leslie Shapiro) Date: Tue, 14 Sep 2004 09:54:46 +0100 Subject: [slime-cvs] your appointment is next monday Message-ID: An HTML attachment was scrubbed... URL: From asimon at common-lisp.net Tue Sep 14 09:15:01 2004 From: asimon at common-lisp.net (Andras Simon) Date: Tue, 14 Sep 2004 11:15:01 +0200 Subject: [slime-cvs] CVS update: slime/swank-abcl.lisp Message-ID: Update of /project/slime/cvsroot/slime In directory common-lisp.net:/tmp/cvs-serv32470 Modified Files: swank-abcl.lisp Log Message: arglist Date: Tue Sep 14 11:15:00 2004 Author: asimon Index: slime/swank-abcl.lisp diff -u slime/swank-abcl.lisp:1.12 slime/swank-abcl.lisp:1.13 --- slime/swank-abcl.lisp:1.12 Tue Sep 14 01:11:37 2004 +++ slime/swank-abcl.lisp Tue Sep 14 11:15:00 2004 @@ -31,7 +31,12 @@ )) ;;; swank-mop + +;;dummies: (defclass standard-slot-definition ()()) +(defun class-finalized-p (class) t) +(defun slot-definition-documentation (slot)) +(defun slot-definition-type (slot) t) (import-to-swank-mop '( ;; classes @@ -47,6 +52,7 @@ sys::class-direct-subclasses sys::class-direct-superclasses ; openmcl-mop:class-finalized-p + class-finalized-p ;;dummy cl:class-name sys::class-precedence-list ; openmcl-mop:class-prototype @@ -68,11 +74,13 @@ ;; slot readers sys::slot-definition-allocation ; ccl::slot-definition-documentation + slot-definition-documentation ;;dummy sys::slot-definition-initargs sys::slot-definition-initform sys::slot-definition-initfunction sys::slot-definition-name ; openmcl-mop:slot-definition-type + slot-definition-type ;;dummy sys::slot-definition-readers sys::slot-definition-writers)) @@ -122,9 +130,14 @@ ;;;; Misc -(defimplementation arglist (symbol) + +(defimplementation arglist ((symbol symbol)) (handler-case (sys::arglist symbol) (simple-error () :not-available))) + +;;It's a string, not a symbol, but this is better than nothing. +(defimplementation function-name (function) + (nth-value 2 (function-lambda-expression function))) (defimplementation macroexpand-all (form) (macroexpand form)) From asimon at common-lisp.net Tue Sep 14 11:41:56 2004 From: asimon at common-lisp.net (Andras Simon) Date: Tue, 14 Sep 2004 13:41:56 +0200 Subject: [slime-cvs] CVS update: slime/swank.lisp Message-ID: Update of /project/slime/cvsroot/slime In directory common-lisp.net:/tmp/cvs-serv6704 Modified Files: swank.lisp Log Message: (:newline) before the property list Date: Tue Sep 14 13:41:55 2004 Author: asimon Index: slime/swank.lisp diff -u slime/swank.lisp:1.232 slime/swank.lisp:1.233 --- slime/swank.lisp:1.232 Mon Sep 13 23:36:13 2004 +++ slime/swank.lisp Tue Sep 14 13:41:55 2004 @@ -2625,6 +2625,7 @@ "It is " ,(case internal-external (:internal "internal") (:external "external")) " to the package: " (:value ,(symbol-package symbol)) + (:newline) ,@(when (eql :internal internal-external) `(" " (:action ,(with-output-to-string (export-label) (princ "[export from " export-label) From asimon at common-lisp.net Tue Sep 14 11:57:07 2004 From: asimon at common-lisp.net (Andras Simon) Date: Tue, 14 Sep 2004 13:57:07 +0200 Subject: [slime-cvs] CVS update: slime/swank.lisp Message-ID: Update of /project/slime/cvsroot/slime In directory common-lisp.net:/tmp/cvs-serv14640 Modified Files: swank.lisp Log Message: (:newline) before the property list (now really!) Date: Tue Sep 14 13:57:07 2004 Author: asimon Index: slime/swank.lisp diff -u slime/swank.lisp:1.233 slime/swank.lisp:1.234 --- slime/swank.lisp:1.233 Tue Sep 14 13:41:55 2004 +++ slime/swank.lisp Tue Sep 14 13:57:06 2004 @@ -2625,13 +2625,13 @@ "It is " ,(case internal-external (:internal "internal") (:external "external")) " to the package: " (:value ,(symbol-package symbol)) - (:newline) ,@(when (eql :internal internal-external) `(" " (:action ,(with-output-to-string (export-label) (princ "[export from " export-label) (princ (package-name (symbol-package symbol)) export-label) (princ "]" export-label)) ,(lambda () (export symbol (symbol-package symbol)))))) + (:newline) "Property list: " (:value ,(symbol-plist symbol)) (:newline) , at package From asimon at common-lisp.net Tue Sep 14 12:17:48 2004 From: asimon at common-lisp.net (Andras Simon) Date: Tue, 14 Sep 2004 14:17:48 +0200 Subject: [slime-cvs] CVS update: slime/swank-abcl.lisp Message-ID: Update of /project/slime/cvsroot/slime In directory common-lisp.net:/tmp/cvs-serv16838 Modified Files: swank-abcl.lisp Log Message: More dummies for swank-mop. Date: Tue Sep 14 14:17:46 2004 Author: asimon Index: slime/swank-abcl.lisp diff -u slime/swank-abcl.lisp:1.13 slime/swank-abcl.lisp:1.14 --- slime/swank-abcl.lisp:1.13 Tue Sep 14 11:15:00 2004 +++ slime/swank-abcl.lisp Tue Sep 14 14:17:44 2004 @@ -37,11 +37,12 @@ (defun class-finalized-p (class) t) (defun slot-definition-documentation (slot)) (defun slot-definition-type (slot) t) +(defun class-prototype (class)) +(defun generic-function-declarations (gf)) (import-to-swank-mop '( ;; classes cl:standard-generic-function -; ccl::standard-slot-definition standard-slot-definition ;;dummy cl:method cl:standard-class @@ -51,15 +52,14 @@ sys::class-direct-slots sys::class-direct-subclasses sys::class-direct-superclasses -; openmcl-mop:class-finalized-p class-finalized-p ;;dummy cl:class-name sys::class-precedence-list -; openmcl-mop:class-prototype + class-prototype ;;dummy sys::class-slots ;; generic function readers sys::generic-function-argument-precedence-order -; openmcl-mop:generic-function-declarations + generic-function-declarations ;;dummy sys::generic-function-lambda-list sys::generic-function-methods sys::generic-function-method-class @@ -73,13 +73,11 @@ sys::method-qualifiers ;; slot readers sys::slot-definition-allocation -; ccl::slot-definition-documentation slot-definition-documentation ;;dummy sys::slot-definition-initargs sys::slot-definition-initform sys::slot-definition-initfunction sys::slot-definition-name -; openmcl-mop:slot-definition-type slot-definition-type ;;dummy sys::slot-definition-readers sys::slot-definition-writers)) From mbaringer at common-lisp.net Tue Sep 14 16:01:10 2004 From: mbaringer at common-lisp.net (Marco Baringer) Date: Tue, 14 Sep 2004 18:01:10 +0200 Subject: [slime-cvs] CVS update: slime/swank-sbcl.lisp slime/swank-openmcl.lisp slime/swank-lispworks.lisp slime/swank-cmucl.lisp slime/swank-backend.lisp slime/swank-allegro.lisp slime/ChangeLog Message-ID: Update of /project/slime/cvsroot/slime In directory common-lisp.net:/tmp/cvs-serv18999 Modified Files: swank-sbcl.lisp swank-openmcl.lisp swank-lispworks.lisp swank-cmucl.lisp swank-backend.lisp swank-allegro.lisp ChangeLog Log Message: 2004-09-14 Marco Baringer * swank-backend.lisp (inspector, make-default-inspector): Add an INSPECTOR object argument to the inspector protocol. This allows implementations to provide more information regarding cretain objects which can't be, or simply aren't, inspected using the generic inspector implementation. also export inspect-for-emacs and related symbols from the backend package. (make-default-inspector): New function. * swank.lisp (inspected-parts): Rename to inspect-for-emacs and add an inspector argument. Move inspect-for-emacs to swank-backend.lisp, leave only the default implementations. * swank-openml.lisp, swank-sbcl.lisp, swank-allegro.lisp, swank-cmucl.lisp, swank-lispworks.lisp (inspected-parts): Rename and change argument list. Many of the inspected-parts methods were being clobbered by the inspected-parts in swank.lisp, now that they're being used the return values have been updated for the new inspect-for-emacs API. Date: Tue Sep 14 18:01:07 2004 Author: mbaringer Index: slime/swank-sbcl.lisp diff -u slime/swank-sbcl.lisp:1.101 slime/swank-sbcl.lisp:1.102 --- slime/swank-sbcl.lisp:1.101 Mon Sep 13 18:42:31 2004 +++ slime/swank-sbcl.lisp Tue Sep 14 18:01:06 2004 @@ -658,78 +658,98 @@ ;;;; Inspector -(defmethod inspected-parts (o) +(defclass sbcl-inspector (inspector) + ()) + +(defimplementation make-default-inspector () + (make-instance 'sbcl-inspector)) + +(defmethod inspect-for-emacs ((o t) (inspector sbcl-inspector)) + (declare (ignore inspector)) (cond ((sb-di::indirect-value-cell-p o) - (inspected-parts-of-value-cell o)) + (values "A value cell." + `("Value: " (:value ,(sb-kernel:value-cell-ref o))))) (t (multiple-value-bind (text labeledp parts) (sb-impl::inspected-parts o) - (let ((parts (if labeledp - (loop for (label . value) in parts - collect (cons (string label) value)) - (loop for value in parts - for i from 0 - collect (cons (format nil "~D" i) value))))) - (values text parts)))))) - -(defun inspected-parts-of-value-cell (o) - (values (format nil "~A~% is a value cell." o) - (list (cons "Value" (sb-kernel:value-cell-ref o))))) + (if labeledp + (values text + (loop for (label . value) in parts + collect `(:value ,label) + collect " = " + collect `(:value ,value) + collect '(:newline))) + (values text + (loop for value in parts + for i from 0 + collect (princ-to-string i) + collect " = " + collect `(:value ,value) + collect '(:newline)))))))) -(defmethod inspected-parts ((o function)) +(defmethod inspect-for-emacs ((o function) (inspector sbcl-inspector)) + (declare (ignore inspector)) (let ((header (sb-kernel:widetag-of o))) (cond ((= header sb-vm:simple-fun-header-widetag) - (values - (format nil "~A~% is a simple-fun." o) - (list (cons "Self" (sb-kernel:%simple-fun-self o)) - (cons "Next" (sb-kernel:%simple-fun-next o)) - (cons "Name" (sb-kernel:%simple-fun-name o)) - (cons "Arglist" (sb-kernel:%simple-fun-arglist o)) - (cons "Type" (sb-kernel:%simple-fun-type o)) - (cons "Code Object" (sb-kernel:fun-code-header o))))) + (values "A simple-fun." + `("Self: " (:value ,(sb-kernel:%simple-fun-self o)) + (:newline) + "Next: " (:value ,(sb-kernel:%simple-fun-next o)) + (:newline) + "Name: " (:value ,(sb-kernel:%simple-fun-name o)) + (:newline) + "Arglist: " (:value ,(sb-kernel:%simple-fun-arglist o)) + (:newline) + "Type: " (:value ,(sb-kernel:%simple-fun-type o)) + (:newline) + "Code Object: " (:value ,(sb-kernel:fun-code-header o))))) ((= header sb-vm:closure-header-widetag) - (values (format nil "~A~% is a closure." o) - (list* - (cons "Function" (sb-kernel:%closure-fun o)) - (loop for i from 0 + (values "A closure." + `("Function: " (:value ,(sb-kernel:%closure-fun o)) + (:newline) + "Closed over values:" + (:newline) + ,@(loop for i from 0 below (- (sb-kernel:get-closure-length o) (1- sb-vm:closure-info-offset)) - collect (cons (format nil "~D" i) - (sb-kernel:%closure-index-ref o i)))))) + collect (princ-to-string i) + collect " = " + collect `(:value ,(sb-kernel:%closure-index-ref o i)) + collect '(:newline))))) (t (call-next-method o))))) -(defmethod inspected-parts ((o sb-kernel:code-component)) - (values (format nil "~A~% is a code data-block." o) - `(("First entry point" . ,(sb-kernel:%code-entry-points o)) - ,@(loop for i from sb-vm:code-constants-offset - below (sb-kernel:get-header-data o) - collect (cons (format nil "Constant#~D" i) - (sb-kernel:code-header-ref o i))) - ("Debug info" . ,(sb-kernel:%code-debug-info o)) - ("Instructions" . ,(sb-kernel:code-instructions o))))) - -(defmethod inspected-parts ((o sb-kernel:fdefn)) - (values (format nil "~A~% is a fdefn object." o) - `(("Name" . ,(sb-kernel:fdefn-name o)) - ("Function" . ,(sb-kernel:fdefn-fun o))))) - - -(defmethod inspected-parts ((o generic-function)) - (values (format nil "~A~% is a generic function." o) - (list - (cons "Method-Class" (sb-pcl:generic-function-method-class o)) - (cons "Methods" (sb-pcl:generic-function-methods o)) - (cons "Name" (sb-pcl:generic-function-name o)) - (cons "Declarations" (sb-pcl:generic-function-declarations o)) - (cons "Method-Combination" - (sb-pcl:generic-function-method-combination o)) - (cons "Lambda-List" (sb-pcl:generic-function-lambda-list o)) - (cons "Precedence-Order" - (sb-pcl:generic-function-argument-precedence-order o)) - (cons "Pretty-Arglist" - (sb-pcl::generic-function-pretty-arglist o)) - (cons "Initial-Methods" - (sb-pcl::generic-function-initial-methods o))))) +(defmethod inspect-for-emacs ((o sb-kernel:code-component) (inspector sbcl-inspector)) + (declare (ignore inspector)) + (values "A code data-block." + `("First entry point: " (:value ,(sb-kernel:%code-entry-points o)) + (:newline) + "Constants: " (:newline) + ,@(loop + for i from sb-vm:code-constants-offset + below (sb-kernel:get-header-data o) + collect (princ-to-string i) + collect " = " + collect `(:value ,(sb-kernel:code-header-ref o i)) + collect '(:newline)) + "Debug info: " (:value ,(sb-kernel:%code-debug-info o)) + "Instructions: " (:value ,(sb-kernel:code-instructions o))))) + +(defmethod inspect-for-emacs ((o sb-kernel:fdefn) (inspector sbcl-inspector)) + (declare (ignore sbcl-inspector)) + (values "A fdefn object." + `("Name: " (:value ,(sb-kernel:fdefn-name o)) + (:newline) + "Function" (:value,(sb-kernel:fdefn-fun o))))) + +(defmethod inspect-for-emacs :around ((o generic-function) (inspector sbcl-inspector)) + (declare (ignore inspector)) + (multiple-value-bind (title contents) + (call-next-method) + (values title + (append contents + `("Pretty arglist: " (:value ,(sb-pcl::generic-function-pretty-arglist o)) + (:newline) + "Initial methods: " (:value ,(sb-pcl::generic-function-initial-methods o))))))) ;;;; Support for SBCL syntax Index: slime/swank-openmcl.lisp diff -u slime/swank-openmcl.lisp:1.82 slime/swank-openmcl.lisp:1.83 --- slime/swank-openmcl.lisp:1.82 Mon Sep 13 18:42:31 2004 +++ slime/swank-openmcl.lisp Tue Sep 14 18:01:06 2004 @@ -638,30 +638,38 @@ (< (symbol-value s) 255)) (setf (gethash (symbol-value s) *value2tag*) s))) +;;;; Inspection + +(defclass openmcl-inspector (inspector) + ()) + +(defimplementation make-default-inspector () + (make-instance 'openmcl-inspector)) + (defmethod describe-primitive-type (thing) (let ((typecode (ccl::typecode thing))) (if (gethash typecode *value2tag*) (string (gethash typecode *value2tag*)) (string (nth typecode '(tag-fixnum tag-list tag-misc tag-imm)))))) -(defmethod inspected-parts (o) +(defmethod inspect-for-emacs ((o t) (inspector openmcl-inspector)) + (declare (ignore inspector)) (let* ((i (inspector::make-inspector o)) (count (inspector::compute-line-count i)) (lines - (loop for l below count - for (value label) = (multiple-value-list - (inspector::line-n i l)) - collect (cons (string-right-trim - " :" (string-capitalize - (format nil "~a" label))) - value)))) - (values (string-left-trim - (string #\newline) - (with-output-to-string (s) - (let ((*print-lines* 1) - (*print-right-margin* 80)) - (pprint o s)))) - (cddr lines)))) + (loop + for l below count + for (value label) = (multiple-value-list + (inspector::line-n i l)) + collect `(:value ,label ,(string-capitalize (format nil "~a" label))) + collect " = " + collect `(:value ,value) + collect '(:newline)))) + (values (with-output-to-string (s) + (let ((*print-lines* 1) + (*print-right-margin* 80)) + (pprint o s))) + lines))) ;;; Multiprocessing Index: slime/swank-lispworks.lisp diff -u slime/swank-lispworks.lisp:1.57 slime/swank-lispworks.lisp:1.58 --- slime/swank-lispworks.lisp:1.57 Mon Sep 13 21:09:15 2004 +++ slime/swank-lispworks.lisp Tue Sep 14 18:01:06 2004 @@ -578,12 +578,33 @@ (make-dspec-location dspec location))))) ;;; Inspector -(defmethod inspected-parts (o) +(defclass lispworks-inspector (inspector) + ()) + +(defimplementation make-default-inspector () + (make-instance 'lispworks-inspector)) + +(defimplementation inspect-for-emacs ((o t) (inspector lispworks-inspector)) + (declare (ignore inspector)) (multiple-value-bind (names values _getter _setter type) (lw:get-inspector-values o nil) (declare (ignore _getter _setter)) - (values (format nil "~A~% is a ~A" o type) - (mapcar #'cons names values)))) + (values "A value." + `("Type: " (:value ,type) + (:newline) + "Getter: " (:value ,_getter) + (:newline) + "Setter: " (:value ,_setter) + (:newline) + "Slots:" + (:newline) + ,@(loop + for name in names + for value in values + collect `(:value ,name) + collect " = " + collect `(:value ,value) + collect `(:newline)))))) ;;; Miscellaneous Index: slime/swank-cmucl.lisp diff -u slime/swank-cmucl.lisp:1.115 slime/swank-cmucl.lisp:1.116 --- slime/swank-cmucl.lisp:1.115 Mon Sep 13 18:42:31 2004 +++ slime/swank-cmucl.lisp Tue Sep 14 18:01:06 2004 @@ -1676,6 +1676,12 @@ ;;;; Inspecting +(defclass cmucl-inspector (inspector) + ()) + +(defimplementation make-default-inspector () + (make-instance 'cmucl-inspector)) + (defconstant +lowtag-symbols+ '(vm:even-fixnum-type vm:function-pointer-type @@ -1718,59 +1724,74 @@ :key #'symbol-value))) (format t ", type: ~A" type-symbol)))))) -(defimplementation inspected-parts (o) +(defimplementation inspect-for-emacs ((o t) (inspector cmucl-inspector)) (cond ((di::indirect-value-cell-p o) - (inspected-parts-of-value-cell o)) + (values "A value cell." + `("Value: " (:value ,(c:value-cell-ref o))))) (t (destructuring-bind (text labeledp . parts) (inspect::describe-parts o) - (let ((parts (if labeledp - (loop for (label . value) in parts - collect (cons (string label) value)) - (loop for value in parts - for i from 0 - collect (cons (format nil "~D" i) value))))) - (values text parts)))))) - -(defun inspected-parts-of-value-cell (o) - (values (format nil "~A~% is a value cell." o) - (list (cons "Value" (c:value-cell-ref o))))) + (values "A value." + (if labeledp + (loop for (label . value) in parts + collect (princ-to-string label) + collect " = " + collect `(:value ,value) + collect '(:newline)) + (loop for value in parts + collect `(:value ,value) + collect '(:newline)))))))) -(defmethod inspected-parts ((o function)) +(defmethod inspect-for-emacs ((o function) (inspector cmucl-inspector)) + (declare (ignore inspector)) (let ((header (kernel:get-type o))) (cond ((= header vm:function-header-type) - (values - (format nil "~A~% is a function." o) - (list (cons "Self" (kernel:%function-self o)) - (cons "Next" (kernel:%function-next o)) - (cons "Name" (kernel:%function-name o)) - (cons "Arglist" (kernel:%function-arglist o)) - (cons "Type" (kernel:%function-type o)) - (cons "Code Object" (kernel:function-code-header o))))) + (values "A function." + `("Self: " (:value ,(kernel:%function-self o)) + (:newline) + "Next: " (:value ,(kernel:%function-next o)) + (:newline) + "Name: " (:value ,(kernel:%function-name o)) + (:newline) + "Arglist: " (:value ,(kernel:%function-arglist o)) + (:newline) + "Type: " (:value ,(kernel:%function-type o)) + (:newline) + "Code Object: " (:value ,(kernel:function-code-header o))))) ((= header vm:closure-header-type) - (values (format nil "~A~% is a closure." o) - (list* - (cons "Function" (kernel:%closure-function o)) - (loop for i from 0 below (- (kernel:get-closure-length o) - (1- vm:closure-info-offset)) - collect (cons (format nil "~D" i) - (kernel:%closure-index-ref o i)))))) + (values "A closure." + (list* + `("Function: " (:value ,(kernel:%closure-function o)) + (:newline) + (loop for i from 0 below (- (kernel:get-closure-length o) + (1- vm:closure-info-offset)) + collect (princ-to-string i) + collect " = " + collect (:value ,(kernel:%closure-index-ref o i))))))) (t (call-next-method o))))) -(defmethod inspected-parts ((o kernel:code-component)) - (values (format nil "~A~% is a code data-block." o) - `(("First entry point" . ,(kernel:%code-entry-points o)) +(defmethod inspect-for-emacs ((o kernel:code-component) (inspector cmucl-inspector)) + (declare (ignore inspector)) + (values "A code data-block." + `("First entry point: " (:value ,(kernel:%code-entry-points o)) + (:newline) + "Constants:" (:newline) ,@(loop for i from vm:code-constants-offset below (kernel:get-header-data o) - collect (cons (format nil "Constant#~D" i) - (kernel:code-header-ref o i))) - ("Debug info" . ,(kernel:%code-debug-info o)) - ("Instructions" . ,(kernel:code-instructions o))))) - -(defmethod inspected-parts ((o kernel:fdefn)) - (values (format nil "~A~% is a fdefn object." o) - `(("Name" . ,(kernel:fdefn-name o)) - ("Function" . ,(kernel:fdefn-function o))))) + collect (princ-to-string i) + collect " = " + collect `(:value ,(kernel:code-header-ref o i)) + collect '(:newline)) + "Debug info: " (:value ,(kernel:%code-debug-info o)) + (:newline) + "Instructions: " (:value ,(kernel:code-instructions o))))) + +(defmethod inspect-for-emacs ((o kernel:fdefn) (inspector cmucl-inspector)) + (declare (ignore inspector)) + (values "A fdefn object." + `("Name: " (:value ,(kernel:fdefn-name o)) + (:newline) + "Function: " (:value ,(kernel:fdefn-function o))))) ;;;; Profiling Index: slime/swank-backend.lisp diff -u slime/swank-backend.lisp:1.66 slime/swank-backend.lisp:1.67 --- slime/swank-backend.lisp:1.66 Mon Sep 13 18:42:31 2004 +++ slime/swank-backend.lisp Tue Sep 14 18:01:07 2004 @@ -26,7 +26,13 @@ #:print-output-to-string #:quit-lisp #:references - #:unbound-slot-filler)) + #:unbound-slot-filler + ;; inspector related symbols + #:inspector + #:inspect-for-emacs + #:raw-inspection + #:fancy-inspection + )) (defpackage :swank-mop (:use) @@ -600,17 +606,57 @@ ;;;; Inspector -(defstruct (unbound-slot-filler (:print-function print-unbound-slot)) - "The definition of an object which serves as a placeholder in -an unbound slot for inspection purposes.") - -(defun print-unbound-slot (o stream depth) - (declare (ignore depth)) - (print-unreadable-object (o stream :type t))) - -(definterface inspected-parts (object) - "Return a short description and a list of (LABEL . VALUE) pairs." - (values (format nil "~S is an atom." object) '())) +(defclass inspector () + () + (:documentation "Super class of inspector objects. + +Implementations should sub class in order to dispatch off of the +inspect-for-emacs method.")) + +(definterface make-default-inspector () + "Return an inspector object suitable for passing to inspect-for-emacs.") + +(definterface inspect-for-emacs (object inspector) + "Explain to emacs how to inspect OBJECT. + +The argument INSPECTOR is an object representing how to get at +the internals of OBJECT, it is usually an implementation specific +class used simply for dispatching to the proper method. + +The orgument INSPECTION-MODE is an object specifying how, and +what, to show to the user. + +Returns two values: a string which will be used as the title of +the inspector buffer and a list specifying how to render the +object for inspection. + +Every elementi of the list must be either a string, which will be +inserted into the buffer as is, or a list of the form: + + (:value object &optional format) - Render an inspectable + object. If format is provided it must be a string and will be + rendered in place of the value, otherwise use princ-to-string. + + (:newline) - Render a \\n + + (:action label lambda) - Render LABEL (a text string) which when + clicked will call LAMBDA. + + NIL - do nothing.") + +(defmethod inspect-for-emacs (object inspector) + "Generic method for inspecting any kind of object. + +Since we don't know how to deal with OBJECT we simply dump the +output of CL:DESCRIBE." + (declare (ignore inspector inspection-mode)) + (values "A value." + `("Type: " (:value ,(type-of object)) + (:newline) + "Don't know how to inspect the object, dumping output of CL:DESCIRBE:" + (:newline) (:newline) + ,(with-output-to-string (desc) + (describe object desc))))) (definterface describe-primitive-type (object) "Return a string describing the primitive type of object." Index: slime/swank-allegro.lisp diff -u slime/swank-allegro.lisp:1.55 slime/swank-allegro.lisp:1.56 --- slime/swank-allegro.lisp:1.55 Tue Sep 14 09:48:50 2004 +++ slime/swank-allegro.lisp Tue Sep 14 18:01:07 2004 @@ -409,17 +409,26 @@ ;;;; Inspecting -(defmethod inspected-parts (o) - (let* ((class (class-of o)) - (slots (clos:class-slots class))) - (values (format nil "~A~% is a ~A" o class) - (mapcar (lambda (slot) - (let ((name (clos:slot-definition-name slot))) - (cons (princ-to-string name) - (if (slot-boundp o name) - (slot-value o name) - (make-unbound-slot-filler))))) - slots)))) +(defclass acl-inspector (inspector) + ()) + +(defimplementation make-default-inspector () + (make-instance 'acl-inspector)) + +(defimplementation inspect-for-emacs ((o t) (inspector acl-inspector)) + (declare (ignore inspector)) + (values "A value." + `("Type: " (:value ,(class-of o)) + (:newline) + "Slots:" (:newline) + ,@(loop + for slot in (clos:class-slots class) + for name = (clos:slot-definition-name slot) + collect `(:value ,name) + collect " = " + collect (if (slot-boundp o name) + `(:value ,(slot-value o name)) + "#"))))) ;; duplicated from swank.lisp in order to avoid package dependencies (defun common-seperated-spec (list &optional (callback (lambda (v) `(:value ,v)))) @@ -429,19 +438,18 @@ collect (funcall callback i) collect ", "))) -;; AllegroCL doesn't support (documentation t) -;; so we get the symbol and then its doc -(defun function-documentation (obj) - (documentation (excl::external-fn_symdef obj) 'function)) - -(defmethod inspected-parts ((f function)) - (values (format nil "The function ~S." f) +(defmethod inspect-for-emacs ((f function) (inspector acl-inspector)) + (declare (ignore inspector)) + (values "A function." `("Name: " (:value ,(function-name f)) (:newline) "It's argument list is: " ,(princ-to-string (arglist f)) (:newline) "Documentation:" (:newline) - ,(function-documentation f)))) + ;; AllegroCL doesn't support (documentation t) + ;; so we get the symbol and then its doc + ,(documentation (excl::external-fn_symdef obj) 'function)))) -(defmethod inspected-parts ((class structure-class)) +(defmethod inspect-for-emacs ((class structure-class) (inspector acl-inspector)) + (declare (ignore inspector)) (values "A structure class." `("Name: " (:value ,(class-name class)) (:newline) @@ -476,7 +484,8 @@ `(:value ,(swank-mop:class-prototype class)) '"N/A (class not finalized)")))) -(defmethod inspected-parts ((slot excl::structure-slot-definition)) +(defmethod inspect-for-emacs ((slot excl::structure-slot-definition) (inspector acl-inspector)) + (declare (ignore inspector)) (values "A structure slot." `("Name: " (:value ,(mop:slot-definition-name slot)) (:newline) @@ -492,7 +501,8 @@ "Allocation: " (:value ,(excl::slotd-allocation slot)) (:newline) "Read-only: " (:value ,(excl::slotd-read-only slot)) (:newline)))) -(defmethod inspected-parts ((o structure-object)) +(defmethod inspect-for-emacs ((o structure-object) (inspector acl-inspector)) + (declare (ignore inspector)) (values "An structure object." `("Structure class: " (:value ,(class-of o)) (:newline) Index: slime/ChangeLog diff -u slime/ChangeLog:1.525 slime/ChangeLog:1.526 --- slime/ChangeLog:1.525 Tue Sep 14 09:48:50 2004 +++ slime/ChangeLog Tue Sep 14 18:01:07 2004 @@ -1,3 +1,24 @@ +2004-09-14 Marco Baringer + + * swank-backend.lisp (inspector, make-default-inspector): Add an + INSPECTOR object argument to the inspector protocol. This allows + implementations to provide more information regarding cretain + objects which can't be, or simply aren't, inspected using the + generic inspector implementation. also export inspect-for-emacs + and related symbols from the backend package. + (make-default-inspector): New function. + + * swank.lisp (inspected-parts): Rename to inspect-for-emacs and + add an inspector argument. Move inspect-for-emacs to + swank-backend.lisp, leave only the default implementations. + + * swank-openml.lisp, swank-sbcl.lisp, swank-allegro.lisp, + swank-cmucl.lisp, swank-lispworks.lisp (inspected-parts): Rename + and change argument list. Many of the inspected-parts methods were + being clobbered by the inspected-parts in swank.lisp, now that + they're being used the return values have been updated for the new + inspect-for-emacs API. + 2004-09-14 Thomas Schilling * swank-allegro.lisp (inspected-parts): Implement inspector for From mbaringer at common-lisp.net Tue Sep 14 16:01:55 2004 From: mbaringer at common-lisp.net (Marco Baringer) Date: Tue, 14 Sep 2004 18:01:55 +0200 Subject: [slime-cvs] CVS update: slime/swank.lisp Message-ID: Update of /project/slime/cvsroot/slime In directory common-lisp.net:/tmp/cvs-serv19195 Modified Files: swank.lisp Log Message: 2004-09-14 Marco Baringer * swank-backend.lisp (inspector, make-default-inspector): Add an INSPECTOR object argument to the inspector protocol. This allows implementations to provide more information regarding cretain objects which can't be, or simply aren't, inspected using the generic inspector implementation. also export inspect-for-emacs and related symbols from the backend package. (make-default-inspector): New function. * swank.lisp (inspected-parts): Rename to inspect-for-emacs and add an inspector argument. Move inspect-for-emacs to swank-backend.lisp, leave only the default implementations. * swank-openml.lisp, swank-sbcl.lisp, swank-allegro.lisp, swank-cmucl.lisp, swank-lispworks.lisp (inspected-parts): Rename and change argument list. Many of the inspected-parts methods were being clobbered by the inspected-parts in swank.lisp, now that they're being used the return values have been updated for the new inspect-for-emacs API. Date: Tue Sep 14 18:01:51 2004 Author: mbaringer Index: slime/swank.lisp diff -u slime/swank.lisp:1.234 slime/swank.lisp:1.235 --- slime/swank.lisp:1.234 Tue Sep 14 13:57:06 2004 +++ slime/swank.lisp Tue Sep 14 18:01:51 2004 @@ -2454,35 +2454,6 @@ ;;;; Inspecting -(defgeneric inspected-parts (object) - (:documentation "Explain to emacs how to inspect OBJECT. - -Returns two values: a string which will be used as the title of -the inspector buffer and a list specifying how to render the -object for inspection. - -Every elementi of the list must be either a string, which will be -inserted into the buffer as is, or a list of the form: - - (:value object &optional format) - Render an inspectable - object. If format is provided it must be a string and will be - rendered in place of the value, otherwise use princ-to-string. - - (:newline) - Render a \\n - - (:action label lambda) - Render LABEL (a text string) which when - clicked will call LAMBDA. - - NIL - do nothing.")) - -(defmethod inspected-parts ((o t)) - "Simply dump the output of CL:DESCRIBE." - (values (format nil "~S" o) - `("Don't know how to inspect the object, dumping output of CL:DESCIRBE:" - (:newline) (:newline) - ,(with-output-to-string (desc) - (describe o desc))))) - (defun common-seperated-spec (list &optional (callback (lambda (v) `(:value ,v)))) (butlast (loop @@ -2490,18 +2461,20 @@ collect (funcall callback i) collect ", "))) -(defmethod inspected-parts ((object cons)) - (if (consp (cdr object)) - (inspected-parts-of-nontrivial-list object) - (inspected-parts-of-simple-cons object))) +(defmethod inspect-for-emacs ((object cons) (inspector t)) + (declare (ignore inspector)) + (if (or (consp (cdr object)) + (null (cdr object))) + (inspect-for-emacs-nontrivial-list object) + (inspect-for-emacs-simple-cons object))) -(defun inspected-parts-of-simple-cons (cons) +(defun inspect-for-emacs-simple-cons (cons) (values "A cons cell." `("Car: " (:value ,(car cons)) (:newline) "Cdr: " (:value ,(cdr cons))))) -(defun inspected-parts-of-nontrivial-list (list) +(defun inspect-for-emacs-nontrivial-list (list) (let ((circularp nil) (length 0) (seen (make-hash-table :test 'eq)) @@ -2525,7 +2498,8 @@ "Contents:" ,@(nreverse contents)))))) -(defmethod inspected-parts ((ht hash-table)) +(defmethod inspect-for-emacs ((ht hash-table) (inspector t)) + (declare (ignore inspector)) (values "A hash table." `("Count: " (:value ,(hash-table-count ht)) (:newline) @@ -2546,7 +2520,8 @@ collect `(:value ,value) collect `(:newline))))) -(defmethod inspected-parts ((array array)) +(defmethod inspect-for-emacs ((array array) (inspector t)) + (declare (ignore inspector)) (values "An array." `("Dimensions: " (:value ,(array-dimensions array)) (:newline) @@ -2573,7 +2548,8 @@ collect `(:value ,element) collect '(:newline))))) -(defmethod inspected-parts ((char character)) +(defmethod inspect-for-emacs ((char character) (inspector t)) + (declare (ignore inspector)) (values "A character." `("Char code: " (:value ,(char-code char)) (:newline) @@ -2586,7 +2562,8 @@ (:value ,(get-macro-character char)) (:newline)))))) -(defmethod inspected-parts ((symbol symbol)) +(defmethod inspect-for-emacs ((symbol symbol) (inspector t)) + (declare (ignore inspector)) (let ((internal-external (multiple-value-bind (symbol status) (intern (symbol-name symbol) (symbol-package symbol)) (declare (ignore symbol)) @@ -2596,7 +2573,9 @@ (package (when (find-package symbol) `("It names the package " (:value ,(find-package symbol)) (:newline)))) (class (when (find-class symbol nil) - `("It names the class " (:value ,(find-class symbol)))))) + `("It names the class " (:value ,(find-class symbol) ,(princ-to-string (class-name (find-class symbol)))) + " " (:action ,(format nil "[remove name ~S (does not affect class object)]" symbol) + (lambda () (setf (find-class symbol) nil))))))) (values "A symbol." `("It's name is: " (:value ,(symbol-name symbol)) (:newline) @@ -2637,7 +2616,8 @@ , at package , at class)))) -(defmethod inspected-parts ((f function)) +(defmethod inspect-for-emacs ((f function) (inspector t)) + (declare (ignore inspector)) (values "A function." `("Name: " (:value ,(function-name f)) (:newline) "It's argument list is: " ,(princ-to-string (arglist f)) @@ -2645,7 +2625,8 @@ ,@(when (documentation f t) `("Documentation:" (:newline) ,(documentation f t) (:newline)))))) -(defmethod inspected-parts ((o standard-object)) +(defmethod inspect-for-emacs ((o standard-object) (inspector t)) + (declare (ignore inspector)) (values "An object." `("Class: " (:value ,(class-of o)) (:newline) @@ -2668,7 +2649,8 @@ collect "#" collect '(:newline))))) -(defmethod inspected-parts ((gf standard-generic-function)) +(defmethod inspect-for-emacs ((gf standard-generic-function) (inspector t)) + (declare (ignore inspector)) (values "A generic function." `("Name: " (:value ,(swank-mop:generic-function-name gf)) (:newline) "It's argument list is: " ,(princ-to-string (swank-mop:generic-function-lambda-list gf)) (:newline) @@ -2694,7 +2676,8 @@ `(:action "[remove method]" ,(lambda () (remove-method gf meth)))) collect '(:newline))))) -(defmethod inspected-parts ((method standard-method)) +(defmethod inspect-for-emacs ((method standard-method) (inspector t)) + (declare (ignore inspector)) (values "A method." `("Method defined on the generic function " (:value ,(swank-mop:method-generic-function method) ,(princ-to-string @@ -2707,9 +2690,12 @@ "Specializers: " (:value ,(swank-mop:method-specializers method) ,(princ-to-string (mapcar #'class-name (swank-mop:method-specializers method)))) (:newline) - "Qualifiers: " (:value ,(swank-mop:method-qualifiers method))))) + "Qualifiers: " (:value ,(swank-mop:method-qualifiers method)) + (:newline) + "Method function: " (:value ,(swank-mop:method-function method))))) -(defmethod inspected-parts ((class standard-class)) +(defmethod inspect-for-emacs ((class standard-class) (inspector t)) + (declare (ignore inspector)) (values "A class." `("Name: " (:value ,(class-name class)) (:newline) @@ -2744,7 +2730,8 @@ `(:value ,(swank-mop:class-prototype class)) '"N/A (class not finalized)")))) -(defmethod inspected-parts ((slot swank-mop:standard-slot-definition)) +(defmethod inspect-for-emacs ((slot swank-mop:standard-slot-definition) (inspector t)) + (declare (ignore inspector)) (values "A slot." `("Name: " (:value ,(swank-mop:slot-definition-name slot)) (:newline) @@ -2759,7 +2746,8 @@ " Function: " (:value ,(swank-mop:slot-definition-initfunction slot)) (:newline)))) -(defmethod inspected-parts ((package package)) +(defmethod inspect-for-emacs ((package package) (inspector t)) + (declare (ignore inspector)) (let ((internal-symbols '()) (external-symbols '())) (do-symbols (sym package) @@ -2801,8 +2789,11 @@ `(:value ,(package-shadowing-symbols package) ,(format nil "~D shadowed symbols." (length (package-shadowing-symbols package))))))))) -(defmethod inspected-parts ((pathname pathname)) - (values "A pathname." +(defmethod inspect-for-emacs ((pathname pathname) (inspector t)) + (declare (ignore inspector)) + (values (if (wild-pathname-p pathname) + "A wild pathname." + "A pathname.") `("Namestring: " (:value ,(namestring pathname)) (:newline) "Host: " (:value ,(pathname-host pathname)) @@ -2816,10 +2807,13 @@ "Type: " (:value ,(pathname-type pathname)) (:newline) "Version: " (:value ,(pathname-version pathname)) - (:newline) - "Truename: " (:value ,(truename pathname))))) + ,@(unless (or (wild-pathname-p pathname) + (not (probe-file pathname))) + `((:newline) + "Truename: " (:value ,(truename pathname))))))) -(defmethod inspected-parts ((pathname logical-pathname)) +(defmethod inspect-for-emacs ((pathname logical-pathname) (inspector t)) + (declare (ignore inspector)) (values "A logical pathname." `("Namestring: " (:value ,(namestring pathname)) (:newline) @@ -2836,10 +2830,12 @@ (:newline) "Version: " (:value ,(pathname-version pathname))))) -(defmethod inspected-parts ((n number)) +(defmethod inspect-for-emacs ((n number) (inspector t)) + (declare (ignore inspector)) (values "A number." `("Value: " ,(princ-to-string n)))) -(defmethod inspected-parts ((i integer)) +(defmethod inspect-for-emacs ((i integer) (inspector t)) + (declare (ignore inspector)) (values "A number." `("Value: " ,(princ-to-string i) " == #x" ,(format nil "~X" i) @@ -2857,13 +2853,15 @@ (format nil "~4,'0D-~2,'0D-~2,'0DT~2,'0D:~2,'0D:~2,'0DZ" year month date hour min sec))))) -(defmethod inspected-parts ((c complex)) +(defmethod inspect-for-emacs ((c complex) (inspector t)) + (declare (ignore inspector)) (values "A complex number." `("Real part: " (:value ,(realpart c)) (:newline) "Imaginary part: " (:value ,(imagpart c))))) -(defmethod inspected-parts ((r ratio)) +(defmethod inspect-for-emacs ((r ratio) (inspector t)) + (declare (ignore inspector)) (values "A non-integer ratio." `("Numerator: " (:value ,(numerator r)) (:newline) @@ -2871,7 +2869,8 @@ (:newline) "As float: " (:value ,(float r))))) -(defmethod inspected-parts ((f float)) +(defmethod inspect-for-emacs ((f float) (inspector t)) + (declare (ignore inspector)) (multiple-value-bind (significand exponent sign) (decode-float f) (values "A floating point number." @@ -2945,7 +2944,7 @@ (map 'nil #'parse-part spec)) (nreverse parse-for-emacs))) -(defun inspect-object (object) +(defun inspect-object (object &optional (inspector (make-default-inspector))) (push (setq *inspectee* object) *inspector-stack*) (unless (find object *inspector-history*) (vector-push-extend object *inspector-history*)) @@ -2953,7 +2952,7 @@ (*print-circle* t) (*print-readably* nil)) (multiple-value-bind (title content) - (inspected-parts object) + (inspect-for-emacs object inspector) (list :title title :type (to-string (type-of object)) :content (inspector-content-for-emacs content))))) From asimon at common-lisp.net Tue Sep 14 17:37:22 2004 From: asimon at common-lisp.net (Andras Simon) Date: Tue, 14 Sep 2004 19:37:22 +0200 Subject: [slime-cvs] CVS update: slime/swank-abcl.lisp Message-ID: Update of /project/slime/cvsroot/slime In directory common-lisp.net:/tmp/cvs-serv12668 Modified Files: swank-abcl.lisp Log Message: Adapt to new inspector api. Date: Tue Sep 14 19:37:21 2004 Author: asimon Index: slime/swank-abcl.lisp diff -u slime/swank-abcl.lisp:1.14 slime/swank-abcl.lisp:1.15 --- slime/swank-abcl.lisp:1.14 Tue Sep 14 14:17:44 2004 +++ slime/swank-abcl.lisp Tue Sep 14 19:37:21 2004 @@ -33,9 +33,12 @@ ;;; swank-mop ;;dummies: + (defclass standard-slot-definition ()()) + (defun class-finalized-p (class) t) -(defun slot-definition-documentation (slot)) + +(defun slot-definition-documentation (slot) #+nil (documentation slot 't)) (defun slot-definition-type (slot) t) (defun class-prototype (class)) (defun generic-function-declarations (gf)) @@ -345,20 +348,43 @@ |# -#| - ;;;; Inspecting -(defmethod inspected-parts (o) +(defclass abcl-inspector (inspector) + ()) + +(defimplementation make-default-inspector () + (make-instance 'abcl-inspector)) + +(defmethod inspect-for-emacs ((slot sys::slot-definition) (inspector t)) + (declare (ignore inspector)) + (values "A slot." + `("Name: " (:value ,(sys::slot-definition-name slot)) + (:newline) + "Documentation:" (:newline) + ,@(when (slot-definition-documentation slot) + `((:value ,(slot-definition-documentation slot)) (:newline))) + "Initialization:" (:newline) + " Args: " (:value ,(sys::slot-definition-initargs slot)) (:newline) + " Form: " ,(if (sys::slot-definition-initfunction slot) + `(:value ,(sys::slot-definition-initform slot)) + "#") (:newline) + " Function: " (:value ,(sys::slot-definition-initfunction slot)) + (:newline)))) + +#| + +(defimplementation inspect-for-emacs ((o t) (inspector abcl-inspector)) (let* ((class (class-of o)) - (slots (clos:class-slots class))) + (slots (sys::class-slots class))) (values (format nil "~A~% is a ~A" o class) (mapcar (lambda (slot) - (let ((name (clos:slot-definition-name slot))) + (let ((name (sys::slot-definition-name slot))) (cons (princ-to-string name) (slot-value o name)))) slots)))) |# + ;;;; Multithreading (defimplementation startup-multiprocessing () From mbaringer at common-lisp.net Tue Sep 14 21:24:59 2004 From: mbaringer at common-lisp.net (Marco Baringer) Date: Tue, 14 Sep 2004 23:24:59 +0200 Subject: [slime-cvs] CVS update: slime/swank-allegro.lisp slime/ChangeLog Message-ID: Update of /project/slime/cvsroot/slime In directory common-lisp.net:/tmp/cvs-serv13122 Modified Files: swank-allegro.lisp ChangeLog Log Message: 2004-09-14 Thomas Schilling * swank-allegro.lisp (inspect-for-emacs): Update for new inspect-for-emacs protocol. Date: Tue Sep 14 23:24:58 2004 Author: mbaringer Index: slime/swank-allegro.lisp diff -u slime/swank-allegro.lisp:1.56 slime/swank-allegro.lisp:1.57 --- slime/swank-allegro.lisp:1.56 Tue Sep 14 18:01:07 2004 +++ slime/swank-allegro.lisp Tue Sep 14 23:24:58 2004 @@ -439,17 +439,15 @@ collect ", "))) (defmethod inspect-for-emacs ((f function) (inspector acl-inspector)) - (declare (ignore inspector)) (values "A function." `("Name: " (:value ,(function-name f)) (:newline) "It's argument list is: " ,(princ-to-string (arglist f)) (:newline) "Documentation:" (:newline) ;; AllegroCL doesn't support (documentation t) ;; so we get the symbol and then its doc - ,(documentation (excl::external-fn_symdef obj) 'function)))) + ,(documentation (excl::external-fn_symdef f) 'function)))) (defmethod inspect-for-emacs ((class structure-class) (inspector acl-inspector)) - (declare (ignore inspector)) (values "A structure class." `("Name: " (:value ,(class-name class)) (:newline) @@ -485,7 +483,6 @@ '"N/A (class not finalized)")))) (defmethod inspect-for-emacs ((slot excl::structure-slot-definition) (inspector acl-inspector)) - (declare (ignore inspector)) (values "A structure slot." `("Name: " (:value ,(mop:slot-definition-name slot)) (:newline) @@ -502,7 +499,6 @@ "Read-only: " (:value ,(excl::slotd-read-only slot)) (:newline)))) (defmethod inspect-for-emacs ((o structure-object) (inspector acl-inspector)) - (declare (ignore inspector)) (values "An structure object." `("Structure class: " (:value ,(class-of o)) (:newline) Index: slime/ChangeLog diff -u slime/ChangeLog:1.526 slime/ChangeLog:1.527 --- slime/ChangeLog:1.526 Tue Sep 14 18:01:07 2004 +++ slime/ChangeLog Tue Sep 14 23:24:58 2004 @@ -1,3 +1,8 @@ +2004-09-14 Thomas Schilling + + * swank-allegro.lisp (inspect-for-emacs): Update for new + inspect-for-emacs protocol. + 2004-09-14 Marco Baringer * swank-backend.lisp (inspector, make-default-inspector): Add an From mbaringer at common-lisp.net Tue Sep 14 21:35:13 2004 From: mbaringer at common-lisp.net (Marco Baringer) Date: Tue, 14 Sep 2004 23:35:13 +0200 Subject: [slime-cvs] CVS update: slime/ChangeLog Message-ID: Update of /project/slime/cvsroot/slime In directory common-lisp.net:/tmp/cvs-serv16316 Modified Files: ChangeLog Log Message: Date: Tue Sep 14 23:35:13 2004 Author: mbaringer Index: slime/ChangeLog diff -u slime/ChangeLog:1.527 slime/ChangeLog:1.528 --- slime/ChangeLog:1.527 Tue Sep 14 23:24:58 2004 +++ slime/ChangeLog Tue Sep 14 23:35:13 2004 @@ -1,7 +1,6 @@ 2004-09-14 Thomas Schilling - * swank-allegro.lisp (inspect-for-emacs): Update for new - inspect-for-emacs protocol. + * swank-allegro.lisp (inspect-for-emacs): Fixes to previous patch. 2004-09-14 Marco Baringer From asimon at common-lisp.net Tue Sep 14 22:42:53 2004 From: asimon at common-lisp.net (Andras Simon) Date: Wed, 15 Sep 2004 00:42:53 +0200 Subject: [slime-cvs] CVS update: slime/swank-abcl.lisp Message-ID: Update of /project/slime/cvsroot/slime In directory common-lisp.net:/tmp/cvs-serv5322 Modified Files: swank-abcl.lisp Log Message: Inspector for functions. Date: Wed Sep 15 00:42:52 2004 Author: asimon Index: slime/swank-abcl.lisp diff -u slime/swank-abcl.lisp:1.15 slime/swank-abcl.lisp:1.16 --- slime/swank-abcl.lisp:1.15 Tue Sep 14 19:37:21 2004 +++ slime/swank-abcl.lisp Wed Sep 15 00:42:52 2004 @@ -356,7 +356,7 @@ (defimplementation make-default-inspector () (make-instance 'abcl-inspector)) -(defmethod inspect-for-emacs ((slot sys::slot-definition) (inspector t)) +(defmethod inspect-for-emacs ((slot sys::slot-definition) (inspector abcl-inspector)) (declare (ignore inspector)) (values "A slot." `("Name: " (:value ,(sys::slot-definition-name slot)) @@ -371,6 +371,18 @@ "#") (:newline) " Function: " (:value ,(sys::slot-definition-initfunction slot)) (:newline)))) + +(defmethod inspect-for-emacs ((f function) (inspector abcl-inspector)) + (declare (ignore inspector)) + (values "A function." + `("Name: " (:value ,(function-name f)) (:newline) + "Argument list: " ,(princ-to-string (sys::arglist f)) + (:newline) + #+nil,@(when (documentation f t) + `("Documentation:" (:newline) ,(documentation f t) (:newline))) + ,@(when (function-lambda-expression f) + `("Lambda expression:" + (:newline) ,(prin1-to-string (function-lambda-expression f)) (:newline)))))) #| From lgorrie at common-lisp.net Wed Sep 15 08:54:55 2004 From: lgorrie at common-lisp.net (Luke Gorrie) Date: Wed, 15 Sep 2004 10:54:55 +0200 Subject: [slime-cvs] CVS update: slime/swank.lisp Message-ID: Update of /project/slime/cvsroot/slime In directory common-lisp.net:/tmp/cvs-serv16390 Modified Files: swank.lisp Log Message: (cleanp-connection-threads): Kill all Swank threads for a connction when it terminates. Date: Wed Sep 15 10:54:51 2004 Author: lgorrie Index: slime/swank.lisp diff -u slime/swank.lisp:1.235 slime/swank.lisp:1.236 --- slime/swank.lisp:1.235 Tue Sep 14 18:01:51 2004 +++ slime/swank.lisp Wed Sep 15 10:54:51 2004 @@ -505,6 +505,10 @@ (setf (connection.repl-thread connection) repl-thread) connection))) +(defun cleanup-connection-threads (connection) + (kill-thread (connection.control-thread connection)) + (kill-thread (connection.repl-thread connection))) + (defun repl-loop (connection) (with-connection (connection) (loop (handle-request connection)))) @@ -612,7 +616,8 @@ (make-connection :socket-io socket-io :read #'read-from-control-thread :send #'send-to-control-thread - :serve-requests #'spawn-threads-for-connection)) + :serve-requests #'spawn-threads-for-connection + :cleanup #'cleanup-connection-threads)) (:sigio (make-connection :socket-io socket-io :read #'read-from-socket-io From lgorrie at common-lisp.net Wed Sep 15 08:56:10 2004 From: lgorrie at common-lisp.net (Luke Gorrie) Date: Wed, 15 Sep 2004 10:56:10 +0200 Subject: [slime-cvs] CVS update: slime/ChangeLog Message-ID: Update of /project/slime/cvsroot/slime In directory common-lisp.net:/tmp/cvs-serv16441 Modified Files: ChangeLog Log Message: *** empty log message *** Date: Wed Sep 15 10:56:05 2004 Author: lgorrie Index: slime/ChangeLog diff -u slime/ChangeLog:1.528 slime/ChangeLog:1.529 --- slime/ChangeLog:1.528 Tue Sep 14 23:35:13 2004 +++ slime/ChangeLog Wed Sep 15 10:56:04 2004 @@ -1,3 +1,8 @@ +2004-09-15 Alan Caulkins + + * swank.lisp (cleanp-connection-threads): Kill all Swank threads + for a connction when it terminates. + 2004-09-14 Thomas Schilling * swank-allegro.lisp (inspect-for-emacs): Fixes to previous patch. From lgorrie at common-lisp.net Wed Sep 15 08:57:27 2004 From: lgorrie at common-lisp.net (Luke Gorrie) Date: Wed, 15 Sep 2004 10:57:27 +0200 Subject: [slime-cvs] CVS update: slime/ChangeLog Message-ID: Update of /project/slime/cvsroot/slime In directory common-lisp.net:/tmp/cvs-serv16491 Modified Files: ChangeLog Log Message: *** empty log message *** Date: Wed Sep 15 10:57:26 2004 Author: lgorrie Index: slime/ChangeLog diff -u slime/ChangeLog:1.529 slime/ChangeLog:1.530 --- slime/ChangeLog:1.529 Wed Sep 15 10:56:04 2004 +++ slime/ChangeLog Wed Sep 15 10:57:26 2004 @@ -1,7 +1,7 @@ 2004-09-15 Alan Caulkins * swank.lisp (cleanp-connection-threads): Kill all Swank threads - for a connction when it terminates. + for a connection when it terminates. 2004-09-14 Thomas Schilling From lgorrie at common-lisp.net Wed Sep 15 11:29:06 2004 From: lgorrie at common-lisp.net (Luke Gorrie) Date: Wed, 15 Sep 2004 13:29:06 +0200 Subject: [slime-cvs] CVS update: slime/.cvsignore Message-ID: Update of /project/slime/cvsroot/slime In directory common-lisp.net:/tmp/cvs-serv25213 Modified Files: .cvsignore Log Message: Added *.elc Date: Wed Sep 15 13:29:06 2004 Author: lgorrie Index: slime/.cvsignore diff -u slime/.cvsignore:1.2 slime/.cvsignore:1.3 --- slime/.cvsignore:1.2 Sat Oct 18 07:07:49 2003 +++ slime/.cvsignore Wed Sep 15 13:29:05 2004 @@ -1,3 +1,4 @@ *.x86f *.fasl -*.dfsl \ No newline at end of file +*.dfsl +*.elc From lgorrie at common-lisp.net Wed Sep 15 11:29:27 2004 From: lgorrie at common-lisp.net (Luke Gorrie) Date: Wed, 15 Sep 2004 13:29:27 +0200 Subject: [slime-cvs] CVS update: slime/hyperspec.el Message-ID: Update of /project/slime/cvsroot/slime In directory common-lisp.net:/tmp/cvs-serv25238 Modified Files: hyperspec.el Log Message: Fixed syntax error. Date: Wed Sep 15 13:29:27 2004 Author: lgorrie Index: slime/hyperspec.el diff -u slime/hyperspec.el:1.6 slime/hyperspec.el:1.7 --- slime/hyperspec.el:1.6 Sat Jul 3 02:06:30 2004 +++ slime/hyperspec.el Wed Sep 15 13:29:27 2004 @@ -1113,7 +1113,7 @@ ;;; FORMAT character lookup by Frode Vatvedt Fjeld 20030902 ;;; -:;; adjusted for ILISP by Nikodemus Siivola 20030903 +;;; adjusted for ILISP by Nikodemus Siivola 20030903 (defvar common-lisp-hyperspec-format-history nil "History of format characters looked up in the Common Lisp HyperSpec.") From lgorrie at common-lisp.net Wed Sep 15 11:29:53 2004 From: lgorrie at common-lisp.net (Luke Gorrie) Date: Wed, 15 Sep 2004 13:29:53 +0200 Subject: [slime-cvs] CVS update: slime/ChangeLog Message-ID: Update of /project/slime/cvsroot/slime In directory common-lisp.net:/tmp/cvs-serv25358 Modified Files: ChangeLog Log Message: *** empty log message *** Date: Wed Sep 15 13:29:52 2004 Author: lgorrie Index: slime/ChangeLog diff -u slime/ChangeLog:1.530 slime/ChangeLog:1.531 --- slime/ChangeLog:1.530 Wed Sep 15 10:57:26 2004 +++ slime/ChangeLog Wed Sep 15 13:29:52 2004 @@ -1,3 +1,9 @@ +2004-09-15 Eduardo Mu?oz + + * .cvsignore: Added *.elc + + * hyperspec.el: Fixed syntax error. + 2004-09-15 Alan Caulkins * swank.lisp (cleanp-connection-threads): Kill all Swank threads From mbaringer at common-lisp.net Wed Sep 15 17:26:53 2004 From: mbaringer at common-lisp.net (Marco Baringer) Date: Wed, 15 Sep 2004 19:26:53 +0200 Subject: [slime-cvs] CVS update: slime/slime.el Message-ID: Update of /project/slime/cvsroot/slime In directory common-lisp.net:/tmp/cvs-serv1869 Modified Files: slime.el Log Message: (slime-inspector-label-face, slime-inspector-value-face, slime-inspector-action-face, slime-inspector-type-face): These faces now inherit from similar font-lock- faces. (slime-open-inspector): Use slime-inspector-value-face for values. Date: Wed Sep 15 19:26:52 2004 Author: mbaringer Index: slime/slime.el diff -u slime/slime.el:1.399 slime/slime.el:1.400 --- slime/slime.el:1.399 Mon Sep 13 07:36:27 2004 +++ slime/slime.el Wed Sep 15 19:26:52 2004 @@ -6437,22 +6437,22 @@ :group 'slime-inspector) (defface slime-inspector-label-face - '((t (:bold t))) + '((t (:inherit font-lock-constant-face))) "Face for labels in the inspector." :group 'slime-inspector) (defface slime-inspector-value-face - '((t ())) + '((t (:inherit font-lock-builtin-face))) "Face for things which can themselves be inspected." :group 'slime-inspector) (defface slime-inspector-action-face - '((t (:italic t))) + '((t (:inherit font-lock-warning-face))) "Face for labels of inspector actions." :group 'slime-inspector) (defface slime-inspector-type-face - '((t ())) + '((t (:inherit font-lock-type-face))) "Face for type description in inspector." :group 'slime-inspector) @@ -6506,7 +6506,7 @@ (:value (destructuring-bind (string id) (cdr part) (slime-propertize-region `(slime-part-number ,id) - (insert (fontify label string))))) + (insert (fontify value string))))) (:action (destructuring-bind (string id) (cdr part) (slime-propertize-region `(slime-action-number ,id) @@ -6516,6 +6516,8 @@ t))) (defun slime-inspector-operate-on-point () + "If point is on a value then recursivly call the inspcetor on + that value. If point is on an action then call that action." (interactive) (cond ((get-text-property (point) 'slime-part-number) From mbaringer at common-lisp.net Wed Sep 15 17:29:40 2004 From: mbaringer at common-lisp.net (Marco Baringer) Date: Wed, 15 Sep 2004 19:29:40 +0200 Subject: [slime-cvs] CVS update: slime/swank.lisp Message-ID: Update of /project/slime/cvsroot/slime In directory common-lisp.net:/tmp/cvs-serv1935 Modified Files: swank.lisp Log Message: (inspect-for-emacs): Add function and compiler-macro documentation when inspecting symbols. View the truename of logical pathnames where they exist. Fix typos in package inspector (fix by Torsten Poulin ). Date: Wed Sep 15 19:29:39 2004 Author: mbaringer Index: slime/swank.lisp diff -u slime/swank.lisp:1.236 slime/swank.lisp:1.237 --- slime/swank.lisp:1.236 Wed Sep 15 10:54:51 2004 +++ slime/swank.lisp Wed Sep 15 19:29:39 2004 @@ -2523,6 +2523,7 @@ collect `(:value ,key) collect " = " collect `(:value ,value) + collect " " collect `(:newline))))) (defmethod inspect-for-emacs ((array array) (inspector t)) @@ -2602,10 +2603,20 @@ `("It is unbound.")))) (:newline) ,@(if (fboundp symbol) - `("It's function value is " (:value ,(symbol-function symbol)) " " - (:action "[make funbound]" ,(lambda () (fmakunbound symbol)))) - `("It has no function value.")) - (:newline) + (append + (if (macro-function symbol) + `("It a macro with macro-function: " (:value ,(macro-function symbol))) + `("It is a function: " (:value ,(symbol-function symbol)))) + `(" " (:action "[make funbound]" ,(lambda () (fmakunbound symbol)))) + `((:newline)) + (when (documentation symbol 'function) + `("Documentation:" (:newline) ,(documentation symbol 'function) (:newline))) + (when (compiler-macro-function symbol) + `("It also names the compiler macro: " (:value ,(compiler-macro-function symbol)))) + `((:newline)) + (when (documentation symbol 'compiler-macro) + `("Documentation:" (:newline) ,(documentation symbol 'compiler-macro) (:newline)))) + `("It has no function value." (:newline))) "It is " ,(case internal-external (:internal "internal") (:external "external")) " to the package: " (:value ,(symbol-package symbol)) @@ -2716,7 +2727,7 @@ (lambda (slot) `(:value ,slot ,(princ-to-string (swank-mop:slot-definition-name slot))))) - '("N/A (class not finalized)")) + '("#")) (:newline) "Documentation:" (:newline) ,@(when (documentation class t) @@ -2729,11 +2740,11 @@ (common-seperated-spec (swank-mop:class-precedence-list class) (lambda (class) `(:value ,class ,(princ-to-string (class-name class))))) - '("N/A (class not finalized)")) + '("#")) (:newline) "Prototype: " ,(if (swank-mop:class-finalized-p class) `(:value ,(swank-mop:class-prototype class)) - '"N/A (class not finalized)")))) + '"#")))) (defmethod inspect-for-emacs ((slot swank-mop:standard-slot-definition) (inspector t)) (declare (ignore inspector)) @@ -2743,12 +2754,11 @@ "Documentation:" (:newline) ,@(when (swank-mop:slot-definition-documentation slot) `((:value ,(swank-mop:slot-definition-documentation slot)) (:newline))) - "Initialization:" (:newline) - " Args: " (:value ,(swank-mop:slot-definition-initargs slot)) (:newline) - " Form: " ,(if (swank-mop:slot-definition-initfunction slot) + "Init args: " (:value ,(swank-mop:slot-definition-initargs slot)) (:newline) + "Init form: " ,(if (swank-mop:slot-definition-initfunction slot) `(:value ,(swank-mop:slot-definition-initform slot)) "#") (:newline) - " Function: " (:value ,(swank-mop:slot-definition-initfunction slot)) + "Init function: " (:value ,(swank-mop:slot-definition-initfunction slot)) (:newline)))) (defmethod inspect-for-emacs ((package package) (inspector t)) @@ -2783,16 +2793,16 @@ (:newline) ,(if (null external-symbols) "0 external symbols." - `(:value ,external-symbols ,(format nil "~D external symbols." (length external-symbols)))) + `(:value ,external-symbols ,(format nil "~D external symbol~:P." (length external-symbols)))) (:newline) ,(if (null internal-symbols) "0 internal symbols." - `(:value ,internal-symbols ,(format nil "~D internals symbols." (length internal-symbols)))) + `(:value ,internal-symbols ,(format nil "~D internal symbol~:P." (length internal-symbols)))) (:newline) ,(if (null (package-shadowing-symbols package)) "0 shadowed symbols." `(:value ,(package-shadowing-symbols package) - ,(format nil "~D shadowed symbols." (length (package-shadowing-symbols package))))))))) + ,(format nil "~D shadowed symbol~:P." (length (package-shadowing-symbols package))))))))) (defmethod inspect-for-emacs ((pathname pathname) (inspector t)) (declare (ignore inspector)) @@ -2833,7 +2843,11 @@ (:newline) "Type: " (:value ,(pathname-type pathname)) (:newline) - "Version: " (:value ,(pathname-version pathname))))) + "Version: " (:value ,(pathname-version pathname)) + ,@(unless (or (wild-pathname-p pathname) + (not (probe-file pathname))) + `((:newline) + "Truename: " (:value ,(truename pathname))))))) (defmethod inspect-for-emacs ((n number) (inspector t)) (declare (ignore inspector)) @@ -2928,7 +2942,6 @@ (:newline (collect-part (string #\Newline))) (:value (destructuring-bind (object &optional format) (cdr part) - (declare (ignore actions)) (unless (position object *inspectee-parts*) (vector-push-extend object *inspectee-parts*)) (unless format From mbaringer at common-lisp.net Wed Sep 15 17:31:59 2004 From: mbaringer at common-lisp.net (Marco Baringer) Date: Wed, 15 Sep 2004 19:31:59 +0200 Subject: [slime-cvs] CVS update: slime/swank-sbcl.lisp Message-ID: Update of /project/slime/cvsroot/slime In directory common-lisp.net:/tmp/cvs-serv2719 Modified Files: swank-sbcl.lisp Log Message: (inspect-for-emacs): Insert function object's documentation when it's available. Date: Wed Sep 15 19:31:58 2004 Author: mbaringer Index: slime/swank-sbcl.lisp diff -u slime/swank-sbcl.lisp:1.102 slime/swank-sbcl.lisp:1.103 --- slime/swank-sbcl.lisp:1.102 Tue Sep 14 18:01:06 2004 +++ slime/swank-sbcl.lisp Wed Sep 15 19:31:58 2004 @@ -692,13 +692,15 @@ (let ((header (sb-kernel:widetag-of o))) (cond ((= header sb-vm:simple-fun-header-widetag) (values "A simple-fun." - `("Self: " (:value ,(sb-kernel:%simple-fun-self o)) + `("Name: " (:value ,(sb-kernel:%simple-fun-name o)) (:newline) - "Next: " (:value ,(sb-kernel:%simple-fun-next o)) + "Arglist: " (:value ,(sb-kernel:%simple-fun-arglist o)) (:newline) - "Name: " (:value ,(sb-kernel:%simple-fun-name o)) + ,@(when (documentation o t) + `("Documentation: " (:newline) ,(documentation o t) (:newline))) + "Self: " (:value ,(sb-kernel:%simple-fun-self o)) (:newline) - "Arglist: " (:value ,(sb-kernel:%simple-fun-arglist o)) + "Next: " (:value ,(sb-kernel:%simple-fun-next o)) (:newline) "Type: " (:value ,(sb-kernel:%simple-fun-type o)) (:newline) @@ -707,6 +709,8 @@ (values "A closure." `("Function: " (:value ,(sb-kernel:%closure-fun o)) (:newline) + ,@(when (documentation o t) + `("Documentation: " (:newline) ,(documentation o t) (:newline))) "Closed over values:" (:newline) ,@(loop for i from 0 @@ -739,7 +743,10 @@ (values "A fdefn object." `("Name: " (:value ,(sb-kernel:fdefn-name o)) (:newline) - "Function" (:value,(sb-kernel:fdefn-fun o))))) + "Function" (:value,(sb-kernel:fdefn-fun o)) + (:newline) + ,@(when (documentation o t) + `("Documentation: " (:newline) ,(documentation o t) (:newline)))))) (defmethod inspect-for-emacs :around ((o generic-function) (inspector sbcl-inspector)) (declare (ignore inspector)) From mbaringer at common-lisp.net Wed Sep 15 17:33:58 2004 From: mbaringer at common-lisp.net (Marco Baringer) Date: Wed, 15 Sep 2004 19:33:58 +0200 Subject: [slime-cvs] CVS update: slime/swank-cmucl.lisp Message-ID: Update of /project/slime/cvsroot/slime In directory common-lisp.net:/tmp/cvs-serv2882 Modified Files: swank-cmucl.lisp Log Message: (inspect-for-emacs): Insert function object's documentation when it's available. Date: Wed Sep 15 19:33:57 2004 Author: mbaringer Index: slime/swank-cmucl.lisp diff -u slime/swank-cmucl.lisp:1.116 slime/swank-cmucl.lisp:1.117 --- slime/swank-cmucl.lisp:1.116 Tue Sep 14 18:01:06 2004 +++ slime/swank-cmucl.lisp Wed Sep 15 19:33:57 2004 @@ -1747,13 +1747,16 @@ (let ((header (kernel:get-type o))) (cond ((= header vm:function-header-type) (values "A function." - `("Self: " (:value ,(kernel:%function-self o)) + `("Name: " (:value ,(kernel:%function-name o)) (:newline) - "Next: " (:value ,(kernel:%function-next o)) + "Arglist: " (:value ,(kernel:%function-arglist o)) (:newline) - "Name: " (:value ,(kernel:%function-name o)) + ,@(when (documentation o t) + `("Documentation: " (:newline) ,(documentation o t))) (:newline) - "Arglist: " (:value ,(kernel:%function-arglist o)) + "Self: " (:value ,(kernel:%function-self o)) + (:newline) + "Next: " (:value ,(kernel:%function-next o)) (:newline) "Type: " (:value ,(kernel:%function-type o)) (:newline) @@ -1763,6 +1766,8 @@ (list* `("Function: " (:value ,(kernel:%closure-function o)) (:newline) + ,@(when (documentation o t) + `("Documentation: " (:newline) ,(documentation o t) (:newline))) (loop for i from 0 below (- (kernel:get-closure-length o) (1- vm:closure-info-offset)) collect (princ-to-string i) @@ -1784,7 +1789,11 @@ collect '(:newline)) "Debug info: " (:value ,(kernel:%code-debug-info o)) (:newline) - "Instructions: " (:value ,(kernel:code-instructions o))))) + "Instructions: " (:value ,(kernel:code-instructions o)) + (:newline) + ,@(when (documentation o t) + `("Documentation: " (:newline) ,(documentation o t))) + (:newline)))) (defmethod inspect-for-emacs ((o kernel:fdefn) (inspector cmucl-inspector)) (declare (ignore inspector)) From mbaringer at common-lisp.net Wed Sep 15 17:37:06 2004 From: mbaringer at common-lisp.net (Marco Baringer) Date: Wed, 15 Sep 2004 19:37:06 +0200 Subject: [slime-cvs] CVS update: slime/ChangeLog Message-ID: Update of /project/slime/cvsroot/slime In directory common-lisp.net:/tmp/cvs-serv2967 Modified Files: ChangeLog Log Message: Date: Wed Sep 15 19:37:05 2004 Author: mbaringer Index: slime/ChangeLog diff -u slime/ChangeLog:1.531 slime/ChangeLog:1.532 --- slime/ChangeLog:1.531 Wed Sep 15 13:29:52 2004 +++ slime/ChangeLog Wed Sep 15 19:37:05 2004 @@ -1,3 +1,19 @@ +2004-09-15 Marco Baringer + + * slime.el (slime-inspector-label-face, + slime-inspector-value-face, slime-inspector-action-face, + slime-inspector-type-face): These faces now inherit from similar + font-lock- faces. + (slime-open-inspector): Use slime-inspector-value-face for values. + + * swank.lisp (inspect-for-emacs): Add function and compiler-macro + documentation when inspecting symbols. View the truename of + logical pathnames where they exist. Fix typos in package + inspector (fix by Torsten Poulin ). + + * swank-sbcl.lisp, swank-cmucl.lisp (inspect-for-emacs): Insert + function object's documentation when it's available. + 2004-09-15 Eduardo Mu?oz * .cvsignore: Added *.elc From aruttenberg at common-lisp.net Wed Sep 15 18:59:46 2004 From: aruttenberg at common-lisp.net (Alan Ruttenberg) Date: Wed, 15 Sep 2004 20:59:46 +0200 Subject: [slime-cvs] CVS update: slime/swank-openmcl.lisp Message-ID: Update of /project/slime/cvsroot/slime In directory common-lisp.net:/tmp/cvs-serv25816/slime Modified Files: swank-openmcl.lisp Log Message: swank-openmcl: typo in who-references. Fix frame-var-value Date: Wed Sep 15 20:59:45 2004 Author: aruttenberg Index: slime/swank-openmcl.lisp diff -u slime/swank-openmcl.lisp:1.83 slime/swank-openmcl.lisp:1.84 --- slime/swank-openmcl.lisp:1.83 Tue Sep 14 18:01:06 2004 +++ slime/swank-openmcl.lisp Wed Sep 15 20:59:44 2004 @@ -255,10 +255,15 @@ #'(lambda(frame-number p context lfun pc) (when (= frame frame-number) (return-from frame-var-value - (multiple-value-bind (count vsp parent-vsp) + (multiple-value-bind (total vsp parent-vsp) (ccl::count-values-in-frame p context) - (declare (ignore count)) - (ccl::nth-value-in-frame p var context lfun pc vsp parent-vsp))))))) + (loop for count below total + with varcount = -1 + for (value nil name) = (multiple-value-list (ccl::nth-value-in-frame p count context lfun pc vsp parent-vsp)) + when name do (incf varcount) + until (= varcount var) + finally (return value)) + )))))) (defun xref-locations (relation name &optional (inverse nil)) (loop for xref in (if inverse @@ -277,8 +282,8 @@ (remove-duplicates (append (xref-locations :references name) (xref-locations :sets name) - (xref-locations :binds name))) - :test 'equal) + (xref-locations :binds name)) + :test 'equal)) (defimplementation who-sets (name) (xref-locations :sets name)) From aruttenberg at common-lisp.net Wed Sep 15 19:00:23 2004 From: aruttenberg at common-lisp.net (Alan Ruttenberg) Date: Wed, 15 Sep 2004 21:00:23 +0200 Subject: [slime-cvs] CVS update: slime/ChangeLog Message-ID: Update of /project/slime/cvsroot/slime In directory common-lisp.net:/tmp/cvs-serv26940/slime Modified Files: ChangeLog Log Message: Date: Wed Sep 15 21:00:21 2004 Author: aruttenberg Index: slime/ChangeLog diff -u slime/ChangeLog:1.532 slime/ChangeLog:1.533 --- slime/ChangeLog:1.532 Wed Sep 15 19:37:05 2004 +++ slime/ChangeLog Wed Sep 15 21:00:15 2004 @@ -1,3 +1,6 @@ +2004-09-15 Alan Ruttenberg + * swank-openmcl: typo in who-references. Fix frame-var-value + 2004-09-15 Marco Baringer * slime.el (slime-inspector-label-face, From mbaringer at common-lisp.net Thu Sep 16 11:40:41 2004 From: mbaringer at common-lisp.net (Marco Baringer) Date: Thu, 16 Sep 2004 13:40:41 +0200 Subject: [slime-cvs] CVS update: slime/swank.lisp slime/swank-allegro.lisp Message-ID: Update of /project/slime/cvsroot/slime In directory common-lisp.net:/tmp/cvs-serv20138 Modified Files: swank.lisp swank-allegro.lisp Log Message: It's -> Its Date: Thu Sep 16 13:40:40 2004 Author: mbaringer Index: slime/swank.lisp diff -u slime/swank.lisp:1.237 slime/swank.lisp:1.238 --- slime/swank.lisp:1.237 Wed Sep 15 19:29:39 2004 +++ slime/swank.lisp Thu Sep 16 13:40:39 2004 @@ -2531,12 +2531,12 @@ (values "An array." `("Dimensions: " (:value ,(array-dimensions array)) (:newline) - "It's element type is: " (:value ,(array-element-type array)) + "Its element type is: " (:value ,(array-element-type array)) (:newline) "Total size: " (:value ,(array-total-size array)) (:newline) ,@(if (array-has-fill-pointer-p array) - `("It's fill-pointer is " (:value ,(fill-pointer array))) + `("Its fill-pointer is " (:value ,(fill-pointer array))) `("No fill pointer.")) (:newline) ,(if (adjustable-array-p array) @@ -2583,7 +2583,7 @@ " " (:action ,(format nil "[remove name ~S (does not affect class object)]" symbol) (lambda () (setf (find-class symbol) nil))))))) (values "A symbol." - `("It's name is: " (:value ,(symbol-name symbol)) + `("Its name is: " (:value ,(symbol-name symbol)) (:newline) ;; check to see whether it is a global variable, a ;; constant, or a symbol macro. @@ -2612,8 +2612,7 @@ (when (documentation symbol 'function) `("Documentation:" (:newline) ,(documentation symbol 'function) (:newline))) (when (compiler-macro-function symbol) - `("It also names the compiler macro: " (:value ,(compiler-macro-function symbol)))) - `((:newline)) + `("It also names the compiler macro: " (:value ,(compiler-macro-function symbol)) (:newline))) (when (documentation symbol 'compiler-macro) `("Documentation:" (:newline) ,(documentation symbol 'compiler-macro) (:newline)))) `("It has no function value." (:newline))) @@ -2636,7 +2635,7 @@ (declare (ignore inspector)) (values "A function." `("Name: " (:value ,(function-name f)) (:newline) - "It's argument list is: " ,(princ-to-string (arglist f)) + "Its argument list is: " ,(princ-to-string (arglist f)) (:newline) ,@(when (documentation f t) `("Documentation:" (:newline) ,(documentation f t) (:newline)))))) @@ -2669,10 +2668,10 @@ (declare (ignore inspector)) (values "A generic function." `("Name: " (:value ,(swank-mop:generic-function-name gf)) (:newline) - "It's argument list is: " ,(princ-to-string (swank-mop:generic-function-lambda-list gf)) (:newline) + "Its argument list is: " ,(princ-to-string (swank-mop:generic-function-lambda-list gf)) (:newline) "Documentation: " (:newline) ,(princ-to-string (documentation gf t)) (:newline) - "It's method class is: " (:value ,(swank-mop:generic-function-method-class gf)) (:newline) + "Its method class is: " (:value ,(swank-mop:generic-function-method-class gf)) (:newline) "It uses " (:value ,(swank-mop:generic-function-method-combination gf)) " method combination." (:newline) "Methods: " (:newline) ,@(loop Index: slime/swank-allegro.lisp diff -u slime/swank-allegro.lisp:1.57 slime/swank-allegro.lisp:1.58 --- slime/swank-allegro.lisp:1.57 Tue Sep 14 23:24:58 2004 +++ slime/swank-allegro.lisp Thu Sep 16 13:40:39 2004 @@ -441,7 +441,7 @@ (defmethod inspect-for-emacs ((f function) (inspector acl-inspector)) (values "A function." `("Name: " (:value ,(function-name f)) (:newline) - "It's argument list is: " ,(princ-to-string (arglist f)) (:newline) + "Its argument list is: " ,(princ-to-string (arglist f)) (:newline) "Documentation:" (:newline) ;; AllegroCL doesn't support (documentation t) ;; so we get the symbol and then its doc From mbaringer at common-lisp.net Thu Sep 16 12:18:40 2004 From: mbaringer at common-lisp.net (Marco Baringer) Date: Thu, 16 Sep 2004 14:18:40 +0200 Subject: [slime-cvs] CVS update: slime/swank-clisp.lisp Message-ID: Update of /project/slime/cvsroot/slime In directory common-lisp.net:/tmp/cvs-serv1070 Modified Files: swank-clisp.lisp Log Message: (swank-mop): Implement the MOP compatability package. (inspectod-for-emacs): Update for new inspection API. Date: Thu Sep 16 14:18:37 2004 Author: mbaringer Index: slime/swank-clisp.lisp diff -u slime/swank-clisp.lisp:1.34 slime/swank-clisp.lisp:1.35 --- slime/swank-clisp.lisp:1.34 Sat Aug 28 04:27:08 2004 +++ slime/swank-clisp.lisp Thu Sep 16 14:18:36 2004 @@ -32,6 +32,51 @@ (when (find-package "LINUX") (pushnew :linux *features*))) +(import-to-swank-mop + '(;; classes + cl:standard-generic-function + clos:standard-slot-definition + cl:method + cl:standard-class + ;; standard-class readers + clos:class-default-initargs + clos:class-direct-default-initargs + clos:class-direct-slots + clos:class-direct-subclasses + clos:class-direct-superclasses + clos:class-finalized-p + cl:class-name + clos:class-precedence-list + clos:class-prototype + clos:class-slots + ;; generic function readers + clos:generic-function-argument-precedence-order + clos:generic-function-declarations + clos:generic-function-lambda-list + clos:generic-function-methods + clos:generic-function-method-class + clos:generic-function-method-combination + clos:generic-function-name + ;; method readers + clos:method-generic-function + clos:method-function + clos:method-lambda-list + clos:method-specializers + clos:method-qualifiers + ;; slot readers + clos:slot-definition-allocation + clos:slot-definition-initargs + clos:slot-definition-initform + clos:slot-definition-initfunction + clos:slot-definition-name + clos:slot-definition-type + clos:slot-definition-readers + clos:slot-definition-writers + )) + +(defun swank-mop:slot-definition-documentation (slot) + (clos::slot-definition-documentation slot)) + #+linux (defmacro with-blocked-signals ((&rest signals) &body body) (ext:with-gensyms ("SIGPROCMASK" ret mask) @@ -419,7 +464,14 @@ ;;; Inspecting -(defmethod inspected-parts (o) +(defclass clisp-inspector (inspector) + ()) + +(defimplementation make-default-inspector () + (make-instance 'clisp-inspector)) + +(defmethod inspect-for-emacs ((o t) (inspector clisp-inspector)) + (declare (ignore inspector)) (let* ((*print-array* nil) (*print-pretty* t) (*print-circle* t) (*print-escape* t) (*print-lines* custom:*inspect-print-lines*) @@ -433,14 +485,17 @@ (values (format nil "~S~% ~A~{~%~A~}" o (sys::insp-title inspection) (sys::insp-blurb inspection)) - (let ((count (sys::insp-num-slots inspection)) - (pairs '())) - (dotimes (i count) - (multiple-value-bind (value name) - (funcall (sys::insp-nth-slot inspection) i) - (push (cons (princ-to-string (or name i)) value) - pairs))) - (nreverse pairs)))))) + (loop with count = (sys::insp-num-slots inspection) + for i upto count + for (value name) = (multiple-value-list (funcall (sys::insp-nth-slot inspection) i)) + collect `(:value ,name) + collect " = " + collect `(:value ,value) + collect '(:newline)))))) + +(defmethod inspect-for-emacs :around ((n number) (inspector clisp-inspector)) + (let ((custom:*warn-on-floating-point-rational-contagion* nil)) + (call-next-method))) (defimplementation quit-lisp () (#+lisp=cl ext:quit #-lisp=cl lisp:quit code)) From mbaringer at common-lisp.net Thu Sep 16 12:19:03 2004 From: mbaringer at common-lisp.net (Marco Baringer) Date: Thu, 16 Sep 2004 14:19:03 +0200 Subject: [slime-cvs] CVS update: slime/ChangeLog Message-ID: Update of /project/slime/cvsroot/slime In directory common-lisp.net:/tmp/cvs-serv1563 Modified Files: ChangeLog Log Message: Date: Thu Sep 16 14:19:02 2004 Author: mbaringer Index: slime/ChangeLog diff -u slime/ChangeLog:1.533 slime/ChangeLog:1.534 --- slime/ChangeLog:1.533 Wed Sep 15 21:00:15 2004 +++ slime/ChangeLog Thu Sep 16 14:19:02 2004 @@ -1,3 +1,9 @@ +2004-09-16 marco + + * swank-clisp.lisp (swank-mop): Implement the MOP compatability + package. + (inspectod-for-emacs): Update for new inspection API. + 2004-09-15 Alan Ruttenberg * swank-openmcl: typo in who-references. Fix frame-var-value From mbaringer at common-lisp.net Thu Sep 16 15:55:30 2004 From: mbaringer at common-lisp.net (Marco Baringer) Date: Thu, 16 Sep 2004 17:55:30 +0200 Subject: [slime-cvs] CVS update: slime/ChangeLog Message-ID: Update of /project/slime/cvsroot/slime In directory common-lisp.net:/tmp/cvs-serv30770 Modified Files: ChangeLog Log Message: my name is "Marco Baringer", not "macro". Date: Thu Sep 16 17:55:29 2004 Author: mbaringer Index: slime/ChangeLog diff -u slime/ChangeLog:1.534 slime/ChangeLog:1.535 --- slime/ChangeLog:1.534 Thu Sep 16 14:19:02 2004 +++ slime/ChangeLog Thu Sep 16 17:55:29 2004 @@ -1,4 +1,4 @@ -2004-09-16 marco +2004-09-16 Marco Baringer * swank-clisp.lisp (swank-mop): Implement the MOP compatability package. From mbaringer at common-lisp.net Thu Sep 16 15:58:28 2004 From: mbaringer at common-lisp.net (Marco Baringer) Date: Thu, 16 Sep 2004 17:58:28 +0200 Subject: [slime-cvs] CVS update: slime/swank-clisp.lisp Message-ID: Update of /project/slime/cvsroot/slime In directory common-lisp.net:/tmp/cvs-serv328 Modified Files: swank-clisp.lisp Log Message: (swank-mop, inspect-for-emacs): Only define the CLOS parts of the inspector if the underlying lisp provides the required functionality. If not enough MOP is present to implement the inspector then we define some very simple replacement methods. Date: Thu Sep 16 17:58:27 2004 Author: mbaringer Index: slime/swank-clisp.lisp diff -u slime/swank-clisp.lisp:1.35 slime/swank-clisp.lisp:1.36 --- slime/swank-clisp.lisp:1.35 Thu Sep 16 14:18:36 2004 +++ slime/swank-clisp.lisp Thu Sep 16 17:58:27 2004 @@ -32,6 +32,19 @@ (when (find-package "LINUX") (pushnew :linux *features*))) +;;;; if this listp has the complete CLOS then we use it, othewise we +;;;; build up a "fake" swank-mop and then overide the methods in the +;;;; inspector. + +(eval-when (:compile-toplevel :load-toplevel :execute) + (defvar *have-mop* + (if (and (find-package :clos) + (eql :external + (nth-value 1 (find-symbol (string ':standard-slot-definition) :clos)))) + '(and) + '(or)))) + +#+#.*have-mop* (import-to-swank-mop '(;; classes cl:standard-generic-function @@ -74,9 +87,15 @@ clos:slot-definition-writers )) +#+#.*have-mop* (defun swank-mop:slot-definition-documentation (slot) (clos::slot-definition-documentation slot)) +#-#.*have-mop* +(defclass swank-mop:standard-slot-definition () + () + (:documentation "Dummy class created so that swank.lisp will compile and load.")) + #+linux (defmacro with-blocked-signals ((&rest signals) &body body) (ext:with-gensyms ("SIGPROCMASK" ret mask) @@ -493,9 +512,41 @@ collect `(:value ,value) collect '(:newline)))))) -(defmethod inspect-for-emacs :around ((n number) (inspector clisp-inspector)) - (let ((custom:*warn-on-floating-point-rational-contagion* nil)) - (call-next-method))) +#-#.*have-mop* +(defmethod inspect-for-emacs ((o standard-object) (inspector clisp-inspector)) + (declare (ignore inspector)) + (values (format nil "An instance of the class" (class-of o)) + `("Sorry, inspecting of instances is not supported in this version of CLISP." + (:newline) + "Please upgrade to a recent version of CLISP."))) + +#-#.*have-mop* +(defmethod inspect-for-emacs ((gf standard-generic-function) (inspector clisp-inspector)) + (declare (ignore inspector)) + (values "A generic function." + `("Sorry, inspecting of generic functions is not supported in this version of CLISP." + (:newline) + "Please upgrade to a recent version of CLISP."))) + +#-#.*have-mop* +(defmethod inspect-for-emacs ((method standard-method) (inspector t)) + (declare (ignore inspector)) + (values "A standard method." + `("Sorry, inspecting of methods is not supported in this version of CLISP." + (:newline) + "Please upgrade to a recent version of CLISP."))) + +#-#.*have-mop* +(defmethod inspect-for-emacs ((class standard-class) (inspector t)) + (declare (ignore inspector)) + (values "A class." + `("Sorry, inspecting of classes is not supported in this version of CLISP." + (:newline) + "Please upgrade to a recent version of CLISP."))) + +#-#.*have-mop* +(defmethod inspect-for-emacs ((slot swank-mop:standard-slot-definition) (inspector t)) + (declare (ignore inspector))) (defimplementation quit-lisp () (#+lisp=cl ext:quit #-lisp=cl lisp:quit code)) From mbaringer at common-lisp.net Thu Sep 16 15:58:53 2004 From: mbaringer at common-lisp.net (Marco Baringer) Date: Thu, 16 Sep 2004 17:58:53 +0200 Subject: [slime-cvs] CVS update: slime/ChangeLog Message-ID: Update of /project/slime/cvsroot/slime In directory common-lisp.net:/tmp/cvs-serv351 Modified Files: ChangeLog Log Message: Date: Thu Sep 16 17:58:52 2004 Author: mbaringer Index: slime/ChangeLog diff -u slime/ChangeLog:1.535 slime/ChangeLog:1.536 --- slime/ChangeLog:1.535 Thu Sep 16 17:55:29 2004 +++ slime/ChangeLog Thu Sep 16 17:58:52 2004 @@ -1,8 +1,15 @@ 2004-09-16 Marco Baringer + * swank-clisp.lisp (swank-mop, inspect-for-emacs): Only define the + CLOS parts of the inspector if the underlying lisp provides the + required functionality. If not enough MOP is present to implement + the inspector then we define some very simple replacement methods. + +2004-09-16 Marco Baringer + * swank-clisp.lisp (swank-mop): Implement the MOP compatability package. - (inspectod-for-emacs): Update for new inspection API. + (inspect-for-emacs): Update for new inspection API. 2004-09-15 Alan Ruttenberg * swank-openmcl: typo in who-references. Fix frame-var-value From mbaringer at common-lisp.net Thu Sep 16 16:38:02 2004 From: mbaringer at common-lisp.net (Marco Baringer) Date: Thu, 16 Sep 2004 18:38:02 +0200 Subject: [slime-cvs] CVS update: slime/swank-clisp.lisp Message-ID: Update of /project/slime/cvsroot/slime In directory common-lisp.net:/tmp/cvs-serv12438 Modified Files: swank-clisp.lisp Log Message: Date: Thu Sep 16 18:38:02 2004 Author: mbaringer Index: slime/swank-clisp.lisp diff -u slime/swank-clisp.lisp:1.36 slime/swank-clisp.lisp:1.37 --- slime/swank-clisp.lisp:1.36 Thu Sep 16 17:58:27 2004 +++ slime/swank-clisp.lisp Thu Sep 16 18:38:01 2004 @@ -38,60 +38,58 @@ (eval-when (:compile-toplevel :load-toplevel :execute) (defvar *have-mop* - (if (and (find-package :clos) - (eql :external - (nth-value 1 (find-symbol (string ':standard-slot-definition) :clos)))) - '(and) - '(or)))) - -#+#.*have-mop* -(import-to-swank-mop - '(;; classes - cl:standard-generic-function - clos:standard-slot-definition - cl:method - cl:standard-class - ;; standard-class readers - clos:class-default-initargs - clos:class-direct-default-initargs - clos:class-direct-slots - clos:class-direct-subclasses - clos:class-direct-superclasses - clos:class-finalized-p - cl:class-name - clos:class-precedence-list - clos:class-prototype - clos:class-slots - ;; generic function readers - clos:generic-function-argument-precedence-order - clos:generic-function-declarations - clos:generic-function-lambda-list - clos:generic-function-methods - clos:generic-function-method-class - clos:generic-function-method-combination - clos:generic-function-name - ;; method readers - clos:method-generic-function - clos:method-function - clos:method-lambda-list - clos:method-specializers - clos:method-qualifiers - ;; slot readers - clos:slot-definition-allocation - clos:slot-definition-initargs - clos:slot-definition-initform - clos:slot-definition-initfunction - clos:slot-definition-name - clos:slot-definition-type - clos:slot-definition-readers - clos:slot-definition-writers - )) - -#+#.*have-mop* -(defun swank-mop:slot-definition-documentation (slot) - (clos::slot-definition-documentation slot)) + (and (find-package :clos) + (eql :external + (nth-value 1 (find-symbol (string ':standard-slot-definition) :clos)))) + "True in those CLISP imagse which have a complete MOP implementation.")) + +#+#.(cl:if swank-backend::*have-mop* '(cl:and) '(cl:or)) +(progn + (import-to-swank-mop + '( ;; classes + cl:standard-generic-function + clos:standard-slot-definition + cl:method + cl:standard-class + ;; standard-class readers + clos:class-default-initargs + clos:class-direct-default-initargs + clos:class-direct-slots + clos:class-direct-subclasses + clos:class-direct-superclasses + clos:class-finalized-p + cl:class-name + clos:class-precedence-list + clos:class-prototype + clos:class-slots + ;; generic function readers + clos:generic-function-argument-precedence-order + clos:generic-function-declarations + clos:generic-function-lambda-list + clos:generic-function-methods + clos:generic-function-method-class + clos:generic-function-method-combination + clos:generic-function-name + ;; method readers + clos:method-generic-function + clos:method-function + clos:method-lambda-list + clos:method-specializers + clos:method-qualifiers + ;; slot readers + clos:slot-definition-allocation + clos:slot-definition-initargs + clos:slot-definition-initform + clos:slot-definition-initfunction + clos:slot-definition-name + clos:slot-definition-type + clos:slot-definition-readers + clos:slot-definition-writers)) + + (defun swank-mop:slot-definition-documentation (slot) + (clos::slot-definition-documentation slot))) -#-#.*have-mop* +#-#.(cl:if swank-backend::*have-mop* '(and) '(or)) (defclass swank-mop:standard-slot-definition () () (:documentation "Dummy class created so that swank.lisp will compile and load.")) @@ -512,41 +510,38 @@ collect `(:value ,value) collect '(:newline)))))) -#-#.*have-mop* -(defmethod inspect-for-emacs ((o standard-object) (inspector clisp-inspector)) +#-#.(cl:if swank-backend::*have-mop* '(cl:and) '(cl:or)) +(progn + (defmethod inspect-for-emacs ((o standard-object) (inspector clisp-inspector)) (declare (ignore inspector)) (values (format nil "An instance of the class" (class-of o)) `("Sorry, inspecting of instances is not supported in this version of CLISP." (:newline) "Please upgrade to a recent version of CLISP."))) -#-#.*have-mop* -(defmethod inspect-for-emacs ((gf standard-generic-function) (inspector clisp-inspector)) - (declare (ignore inspector)) - (values "A generic function." - `("Sorry, inspecting of generic functions is not supported in this version of CLISP." - (:newline) - "Please upgrade to a recent version of CLISP."))) - -#-#.*have-mop* -(defmethod inspect-for-emacs ((method standard-method) (inspector t)) - (declare (ignore inspector)) - (values "A standard method." - `("Sorry, inspecting of methods is not supported in this version of CLISP." - (:newline) - "Please upgrade to a recent version of CLISP."))) - -#-#.*have-mop* -(defmethod inspect-for-emacs ((class standard-class) (inspector t)) - (declare (ignore inspector)) - (values "A class." - `("Sorry, inspecting of classes is not supported in this version of CLISP." - (:newline) - "Please upgrade to a recent version of CLISP."))) + (defmethod inspect-for-emacs ((gf standard-generic-function) (inspector clisp-inspector)) + (declare (ignore inspector)) + (values "A generic function." + `("Sorry, inspecting of generic functions is not supported in this version of CLISP." + (:newline) + "Please upgrade to a recent version of CLISP."))) + + (defmethod inspect-for-emacs ((method standard-method) (inspector t)) + (declare (ignore inspector)) + (values "A standard method." + `("Sorry, inspecting of methods is not supported in this version of CLISP." + (:newline) + "Please upgrade to a recent version of CLISP."))) + + (defmethod inspect-for-emacs ((class standard-class) (inspector t)) + (declare (ignore inspector)) + (values "A class." + `("Sorry, inspecting of classes is not supported in this version of CLISP." + (:newline) + "Please upgrade to a recent version of CLISP."))) -#-#.*have-mop* -(defmethod inspect-for-emacs ((slot swank-mop:standard-slot-definition) (inspector t)) - (declare (ignore inspector))) + (defmethod inspect-for-emacs ((slot swank-mop:standard-slot-definition) (inspector t)) + (declare (ignore inspector)))) (defimplementation quit-lisp () (#+lisp=cl ext:quit #-lisp=cl lisp:quit code)) From mbaringer at common-lisp.net Fri Sep 17 12:48:40 2004 From: mbaringer at common-lisp.net (Marco Baringer) Date: Fri, 17 Sep 2004 14:48:40 +0200 Subject: [slime-cvs] CVS update: slime/swank-allegro.lisp Message-ID: Update of /project/slime/cvsroot/slime In directory common-lisp.net:/tmp/cvs-serv739 Modified Files: swank-allegro.lisp Log Message: Export eql-specializer, eql-specializer-object and specializer-direct-methods from swank-mop. Date: Fri Sep 17 14:48:39 2004 Author: mbaringer Index: slime/swank-allegro.lisp diff -u slime/swank-allegro.lisp:1.58 slime/swank-allegro.lisp:1.59 --- slime/swank-allegro.lisp:1.58 Thu Sep 16 13:40:39 2004 +++ slime/swank-allegro.lisp Fri Sep 17 14:48:39 2004 @@ -36,6 +36,7 @@ mop::standard-slot-definition cl:method cl:standard-class + mop:eql-specializer ;; standard-class readers mop:class-default-initargs mop:class-direct-default-initargs @@ -47,6 +48,9 @@ mop:class-precedence-list mop:class-prototype mop:class-slots + mop:specializer-direct-methods + ;; eql-specializer accessors + mop:eql-specializer-object ;; generic function readers mop:generic-function-argument-precedence-order mop:generic-function-declarations From mbaringer at common-lisp.net Fri Sep 17 12:49:04 2004 From: mbaringer at common-lisp.net (Marco Baringer) Date: Fri, 17 Sep 2004 14:49:04 +0200 Subject: [slime-cvs] CVS update: slime/swank-backend.lisp Message-ID: Update of /project/slime/cvsroot/slime In directory common-lisp.net:/tmp/cvs-serv761 Modified Files: swank-backend.lisp Log Message: Require eql-specializer, eql-specializer-object and specializer-direct-methods in swank-mop package. Date: Fri Sep 17 14:49:04 2004 Author: mbaringer Index: slime/swank-backend.lisp diff -u slime/swank-backend.lisp:1.67 slime/swank-backend.lisp:1.68 --- slime/swank-backend.lisp:1.67 Tue Sep 14 18:01:07 2004 +++ slime/swank-backend.lisp Fri Sep 17 14:49:04 2004 @@ -42,6 +42,8 @@ #:standard-slot-definition #:standard-method #:standard-class + #:eql-specializer + #:eql-specializer-object ;; standard-class readers #:class-default-initargs #:class-direct-default-initargs @@ -53,6 +55,7 @@ #:class-precedence-list #:class-prototype #:class-slots + #:specializer-direct-methods ;; generic function readers #:generic-function-argument-precedence-order #:generic-function-declarations From mbaringer at common-lisp.net Fri Sep 17 12:49:27 2004 From: mbaringer at common-lisp.net (Marco Baringer) Date: Fri, 17 Sep 2004 14:49:27 +0200 Subject: [slime-cvs] CVS update: slime/swank-clisp.lisp Message-ID: Update of /project/slime/cvsroot/slime In directory common-lisp.net:/tmp/cvs-serv784 Modified Files: swank-clisp.lisp Log Message: Export eql-specializer, eql-specializer-object and specializer-direct-methods from swank-mop. Date: Fri Sep 17 14:49:26 2004 Author: mbaringer Index: slime/swank-clisp.lisp diff -u slime/swank-clisp.lisp:1.37 slime/swank-clisp.lisp:1.38 --- slime/swank-clisp.lisp:1.37 Thu Sep 16 18:38:01 2004 +++ slime/swank-clisp.lisp Fri Sep 17 14:49:26 2004 @@ -51,6 +51,7 @@ clos:standard-slot-definition cl:method cl:standard-class + clos::eql-specializer ;; standard-class readers clos:class-default-initargs clos:class-direct-default-initargs @@ -62,6 +63,9 @@ clos:class-precedence-list clos:class-prototype clos:class-slots + clos:specializer-direct-methods + ;; eql-specializer accessors + clos::eql-specializer-object ;; generic function readers clos:generic-function-argument-precedence-order clos:generic-function-declarations From mbaringer at common-lisp.net Fri Sep 17 12:50:09 2004 From: mbaringer at common-lisp.net (Marco Baringer) Date: Fri, 17 Sep 2004 14:50:09 +0200 Subject: [slime-cvs] CVS update: slime/swank-cmucl.lisp Message-ID: Update of /project/slime/cvsroot/slime In directory common-lisp.net:/tmp/cvs-serv810 Modified Files: swank-cmucl.lisp Log Message: (swank-mop): Export eql-specializer, eql-specializer-object and specializer-direct-methods from swank-mop. (inspect-for-emacs): Thinko fix. Date: Fri Sep 17 14:50:08 2004 Author: mbaringer Index: slime/swank-cmucl.lisp diff -u slime/swank-cmucl.lisp:1.117 slime/swank-cmucl.lisp:1.118 --- slime/swank-cmucl.lisp:1.117 Wed Sep 15 19:33:57 2004 +++ slime/swank-cmucl.lisp Fri Sep 17 14:50:08 2004 @@ -23,6 +23,7 @@ pcl:standard-slot-definition cl:method cl:standard-class + pcl:eql-specializer ;; standard-class readers pcl:class-default-initargs pcl:class-direct-default-initargs @@ -34,6 +35,9 @@ pcl:class-precedence-list pcl:class-prototype pcl:class-slots + pcl:specializer-direct-methods + ;; eql-specializer accessors + pcl:eql-specializer-object ;; generic function readers pcl:generic-function-argument-precedence-order pcl:generic-function-declarations @@ -1768,11 +1772,12 @@ (:newline) ,@(when (documentation o t) `("Documentation: " (:newline) ,(documentation o t) (:newline))) - (loop for i from 0 below (- (kernel:get-closure-length o) - (1- vm:closure-info-offset)) - collect (princ-to-string i) - collect " = " - collect (:value ,(kernel:%closure-index-ref o i))))))) + ,@(loop + for i from 0 below (- (kernel:get-closure-length o) + (1- vm:closure-info-offset)) + collect (princ-to-string i) + collect " = " + collect `(:value ,(kernel:%closure-index-ref o i))))))) (t (call-next-method o))))) (defmethod inspect-for-emacs ((o kernel:code-component) (inspector cmucl-inspector)) From mbaringer at common-lisp.net Fri Sep 17 12:50:42 2004 From: mbaringer at common-lisp.net (Marco Baringer) Date: Fri, 17 Sep 2004 14:50:42 +0200 Subject: [slime-cvs] CVS update: slime/swank-lispworks.lisp Message-ID: Update of /project/slime/cvsroot/slime In directory common-lisp.net:/tmp/cvs-serv831 Modified Files: swank-lispworks.lisp Log Message: (swank-mop): Export specializer-direct-methods. (eql-specializer): Implement. (eql-specializer-object): Implement. Date: Fri Sep 17 14:50:41 2004 Author: mbaringer Index: slime/swank-lispworks.lisp diff -u slime/swank-lispworks.lisp:1.58 slime/swank-lispworks.lisp:1.59 --- slime/swank-lispworks.lisp:1.58 Tue Sep 14 18:01:06 2004 +++ slime/swank-lispworks.lisp Fri Sep 17 14:50:41 2004 @@ -42,6 +42,7 @@ clos:class-precedence-list clos:class-prototype clos:class-slots + clos:specializer-direct-methods ;; generic function readers clos:generic-function-argument-precedence-order clos:generic-function-declarations @@ -68,6 +69,13 @@ (defun swank-mop:slot-definition-documentation (slot) (documentation slot t)) + +;;;; lispworks doesn't have the eql-specializer class, it represents +;;;; them as a list of `(EQL ,OBJECT) +(deftype swank-mop:eql-specializer () 'cons) + +(defun swank-mop:eql-specializer-object (eql-spec) + (second eql-spec)) (when (fboundp 'dspec::define-dspec-alias) (dspec::define-dspec-alias defimplementation (name args &rest body) From mbaringer at common-lisp.net Fri Sep 17 12:51:07 2004 From: mbaringer at common-lisp.net (Marco Baringer) Date: Fri, 17 Sep 2004 14:51:07 +0200 Subject: [slime-cvs] CVS update: slime/swank-openmcl.lisp Message-ID: Update of /project/slime/cvsroot/slime In directory common-lisp.net:/tmp/cvs-serv852 Modified Files: swank-openmcl.lisp Log Message: (swank-mop): Export eql-specializer, eql-specializer-object and specializer-direct-methods from swank-mop. Date: Fri Sep 17 14:51:07 2004 Author: mbaringer Index: slime/swank-openmcl.lisp diff -u slime/swank-openmcl.lisp:1.84 slime/swank-openmcl.lisp:1.85 --- slime/swank-openmcl.lisp:1.84 Wed Sep 15 20:59:44 2004 +++ slime/swank-openmcl.lisp Fri Sep 17 14:51:07 2004 @@ -75,6 +75,7 @@ ccl::standard-slot-definition cl:method cl:standard-class + ccl::eql-specializer ;; standard-class readers openmcl-mop:class-default-initargs openmcl-mop:class-direct-default-initargs @@ -86,6 +87,9 @@ openmcl-mop:class-precedence-list openmcl-mop:class-prototype openmcl-mop:class-slots + openmcl-mop:specializer-direct-methods + ;; eql-specializer accessors + openmcl-mop:eql-specializer-object ;; generic function readers openmcl-mop:generic-function-argument-precedence-order openmcl-mop:generic-function-declarations From mbaringer at common-lisp.net Fri Sep 17 12:51:37 2004 From: mbaringer at common-lisp.net (Marco Baringer) Date: Fri, 17 Sep 2004 14:51:37 +0200 Subject: [slime-cvs] CVS update: slime/swank-sbcl.lisp Message-ID: Update of /project/slime/cvsroot/slime In directory common-lisp.net:/tmp/cvs-serv1426 Modified Files: swank-sbcl.lisp Log Message: (swank-mop): Export eql-specializer, eql-specializer-object and specializer-direct-methods from swank-mop. (inspect-for-emacs): Fix typo in ignore declaration. Date: Fri Sep 17 14:51:34 2004 Author: mbaringer Index: slime/swank-sbcl.lisp diff -u slime/swank-sbcl.lisp:1.103 slime/swank-sbcl.lisp:1.104 --- slime/swank-sbcl.lisp:1.103 Wed Sep 15 19:31:58 2004 +++ slime/swank-sbcl.lisp Fri Sep 17 14:51:33 2004 @@ -43,6 +43,7 @@ sb-mop::standard-slot-definition cl:method cl:standard-class + sb-mop:eql-specializer ;; standard-class readers sb-mop:class-default-initargs sb-mop:class-direct-default-initargs @@ -54,6 +55,9 @@ sb-mop:class-precedence-list sb-mop:class-prototype sb-mop:class-slots + sb-mop:specializer-direct-methods + ;; eql-specializer accessors + sb-mop:eql-specializer-object ;; generic function readers sb-mop:generic-function-argument-precedence-order sb-mop:generic-function-declarations @@ -739,7 +743,7 @@ "Instructions: " (:value ,(sb-kernel:code-instructions o))))) (defmethod inspect-for-emacs ((o sb-kernel:fdefn) (inspector sbcl-inspector)) - (declare (ignore sbcl-inspector)) + (declare (ignore inspector)) (values "A fdefn object." `("Name: " (:value ,(sb-kernel:fdefn-name o)) (:newline) From mbaringer at common-lisp.net Fri Sep 17 12:52:23 2004 From: mbaringer at common-lisp.net (Marco Baringer) Date: Fri, 17 Sep 2004 14:52:23 +0200 Subject: [slime-cvs] CVS update: slime/swank.lisp Message-ID: Update of /project/slime/cvsroot/slime In directory common-lisp.net:/tmp/cvs-serv2631 Modified Files: swank.lisp Log Message: Don't print "Documentation:" if none is available; add support for classes specializer-direct-methods; deal with eql-specializers in methods. (inspector-princ): New function. (method-specializers-for-inspect): New function. (method-for-inspect-value): New function. (inspect-for-emacs): Use inspector-princ instead of princ-to-string. Date: Fri Sep 17 14:52:11 2004 Author: mbaringer Index: slime/swank.lisp diff -u slime/swank.lisp:1.238 slime/swank.lisp:1.239 --- slime/swank.lisp:1.238 Thu Sep 16 13:40:39 2004 +++ slime/swank.lisp Fri Sep 17 14:52:11 2004 @@ -2466,6 +2466,29 @@ collect (funcall callback i) collect ", "))) +(defun inspector-princ (list) + "Just like princ-to-string, but don't rewrite (function foo) as + #'foo. Do NOT pass circular lists to this function." + (with-output-to-string (as-string) + (labels ((printer (object) + (typecase object + (null (princ nil as-string)) + (cons + (write-char #\( as-string) + (printer (car object)) + (loop + for (head . tail) on (cdr object) + do (write-char #\Space as-string) + do (printer head) + unless (listp tail) + do (progn + (write-string " . " as-string) + (printer tail)) + and return t) + (write-char #\) as-string)) + (t (princ object as-string))))) + (printer list)))) + (defmethod inspect-for-emacs ((object cons) (inspector t)) (declare (ignore inspector)) (if (or (consp (cdr object)) @@ -2579,7 +2602,7 @@ (package (when (find-package symbol) `("It names the package " (:value ,(find-package symbol)) (:newline)))) (class (when (find-class symbol nil) - `("It names the class " (:value ,(find-class symbol) ,(princ-to-string (class-name (find-class symbol)))) + `("It names the class " (:value ,(find-class symbol) ,(inspector-princ (class-name (find-class symbol)))) " " (:action ,(format nil "[remove name ~S (does not affect class object)]" symbol) (lambda () (setf (find-class symbol) nil))))))) (values "A symbol." @@ -2635,10 +2658,42 @@ (declare (ignore inspector)) (values "A function." `("Name: " (:value ,(function-name f)) (:newline) - "Its argument list is: " ,(princ-to-string (arglist f)) + "Its argument list is: " ,(inspector-princ (arglist f)) (:newline) ,@(when (documentation f t) - `("Documentation:" (:newline) ,(documentation f t) (:newline)))))) + `("Documentation:" (:newline) ,(documentation f t) (:newline))) + ,@(when (and (function-name f) + + ))))) + +(defun method-specializers-for-inspect (method) + "Return a \"pretty\" list of the method's specializers. Normal + specializers are replaced by the name of the class, eql + specializers are replaced by `(eql ,object)." + (mapcar (lambda (spec) + (typecase spec + (swank-mop:eql-specializer + `(eql ,(swank-mop:eql-specializer-object spec))) + (t (swank-mop:class-name spec)))) + (swank-mop:method-specializers method))) + +(defun method-for-inspect-value (method) + "Returns a \"pretty\" list describing METHOD. The first element + of the list is the name of generic-function method is + specialiazed on, the second element is the method qualifiers, + the rest of the list is the method's specialiazers (as per + method-specializers-for-inspect)." + (if (swank-mop:method-qualifiers method) + (list* + (swank-mop:generic-function-name (swank-mop:method-generic-function method)) + (let ((quals (swank-mop:method-qualifiers method))) + (if (= 1 (length quals)) + (first quals) + quals)) + (method-specializers-for-inspect method)) + (list* + (swank-mop:generic-function-name (swank-mop:method-generic-function method)) + (method-specializers-for-inspect method)))) (defmethod inspect-for-emacs ((o standard-object) (inspector t)) (declare (ignore inspector)) @@ -2650,13 +2705,15 @@ with direct-slots = (swank-mop:class-direct-slots (class-of o)) for slot in (swank-mop:class-slots (class-of o)) for slot-def = (or (find-if (lambda (a) - ;; find the direct slot with the same as - ;; SLOT (an effective slot). + ;; find the direct slot + ;; with the same name + ;; as SLOT (an + ;; effective slot). (eql (swank-mop:slot-definition-name a) (swank-mop:slot-definition-name slot))) direct-slots) slot) - collect `(:value ,slot-def ,(princ-to-string (swank-mop:slot-definition-name slot-def))) + collect `(:value ,slot-def ,(inspector-princ (swank-mop:slot-definition-name slot-def))) collect " = " if (slot-boundp o (swank-mop:slot-definition-name slot-def)) collect `(:value ,(slot-value o (swank-mop:slot-definition-name slot-def))) @@ -2668,24 +2725,17 @@ (declare (ignore inspector)) (values "A generic function." `("Name: " (:value ,(swank-mop:generic-function-name gf)) (:newline) - "Its argument list is: " ,(princ-to-string (swank-mop:generic-function-lambda-list gf)) (:newline) + "Its argument list is: " ,(inspector-princ (swank-mop:generic-function-lambda-list gf)) (:newline) "Documentation: " (:newline) - ,(princ-to-string (documentation gf t)) (:newline) + ,(inspector-princ (documentation gf t)) (:newline) "Its method class is: " (:value ,(swank-mop:generic-function-method-class gf)) (:newline) "It uses " (:value ,(swank-mop:generic-function-method-combination gf)) " method combination." (:newline) "Methods: " (:newline) ,@(loop for method in (swank-mop:generic-function-methods gf) - collect `(:value ,method - , (with-output-to-string (meth) - (let ((specs (swank-mop:method-specializers method)) - (quals (swank-mop:method-qualifiers method))) - (princ (mapcar #'class-name specs) meth) - (princ " " meth) - (when quals - (if (= 1 (length quals)) - (princ (first quals) meth) - (princ quals meth)))))) + collect `(:value ,method ,(inspector-princ + ;; drop the first element (the name of the generic function) + (cdr (method-for-inspect-value method)))) collect " " collect (let ((meth method)) `(:action "[remove method]" ,(lambda () (remove-method gf meth)))) @@ -2695,15 +2745,16 @@ (declare (ignore inspector)) (values "A method." `("Method defined on the generic function " (:value ,(swank-mop:method-generic-function method) - ,(princ-to-string + ,(inspector-princ (swank-mop:generic-function-name (swank-mop:method-generic-function method)))) - (:newline) - "Documentation:" (:newline) ,(documentation method t) (:newline) + (:newline) + ,@(when (documentation method t) + `("Documentation:" (:newline) ,(documentation method t) (:newline))) "Lambda List: " (:value ,(swank-mop:method-lambda-list method)) (:newline) "Specializers: " (:value ,(swank-mop:method-specializers method) - ,(princ-to-string (mapcar #'class-name (swank-mop:method-specializers method)))) + ,(inspector-princ (method-specializers-for-inspect method))) (:newline) "Qualifiers: " (:value ,(swank-mop:method-qualifiers method)) (:newline) @@ -2718,29 +2769,35 @@ (:newline) "Direct Slots: " ,@(common-seperated-spec (swank-mop:class-direct-slots class) (lambda (slot) - `(:value ,slot ,(princ-to-string + `(:value ,slot ,(inspector-princ (swank-mop:slot-definition-name slot))))) (:newline) "Effective Slots: " ,@(if (swank-mop:class-finalized-p class) (common-seperated-spec (swank-mop:class-slots class) (lambda (slot) - `(:value ,slot ,(princ-to-string + `(:value ,slot ,(inspector-princ (swank-mop:slot-definition-name slot))))) '("#")) (:newline) - "Documentation:" (:newline) ,@(when (documentation class t) - `(,(documentation class t) (:newline))) + `("Documentation:" (:newline) + ,(documentation class t) (:newline))) "Sub classes: " ,@(common-seperated-spec (swank-mop:class-direct-subclasses class) (lambda (sub) - `(:value ,sub ,(princ-to-string (class-name sub))))) + `(:value ,sub ,(inspector-princ (class-name sub))))) (:newline) "Precedence List: " ,@(if (swank-mop:class-finalized-p class) (common-seperated-spec (swank-mop:class-precedence-list class) (lambda (class) - `(:value ,class ,(princ-to-string (class-name class))))) + `(:value ,class ,(inspector-princ (class-name class))))) '("#")) (:newline) + ,@(when (swank-mop:specializer-direct-methods class) + `("It is used as a direct specializer in the following methods:" (:newline) + ,@(loop + for method in (swank-mop:specializer-direct-methods class) + collect `(:value ,method ,(inspector-princ (method-for-inspect-value method))) + collect '(:newline)))) "Prototype: " ,(if (swank-mop:class-finalized-p class) `(:value ,(swank-mop:class-prototype class)) '"#")))) @@ -2750,9 +2807,10 @@ (values "A slot." `("Name: " (:value ,(swank-mop:slot-definition-name slot)) (:newline) - "Documentation:" (:newline) ,@(when (swank-mop:slot-definition-documentation slot) - `((:value ,(swank-mop:slot-definition-documentation slot)) (:newline))) + `("Documentation:" (:newline) + (:value ,(swank-mop:slot-definition-documentation slot)) + (:newline))) "Init args: " (:value ,(swank-mop:slot-definition-initargs slot)) (:newline) "Init form: " ,(if (swank-mop:slot-definition-initfunction slot) `(:value ,(swank-mop:slot-definition-initform slot)) @@ -2779,16 +2837,16 @@ (:newline) "Nick names: " ,@(common-seperated-spec (sort (package-nicknames package) #'string-lessp)) (:newline) - "Documentation:" (:newline) ,@(when (documentation package t) - `(,(documentation package t) (:newline))) + `("Documentation:" (:newline) + ,(documentation package t) (:newline))) "Use list: " ,@(common-seperated-spec (sort (package-use-list package) #'string-lessp :key #'package-name) (lambda (pack) - `(:value ,pack ,(princ-to-string (package-name pack))))) + `(:value ,pack ,(inspector-princ (package-name pack))))) (:newline) "Used by list: " ,@(common-seperated-spec (sort (package-used-by-list package) #'string-lessp :key #'package-name) (lambda (pack) - `(:value ,pack ,(princ-to-string (package-name pack))))) + `(:value ,pack ,(inspector-princ (package-name pack))))) (:newline) ,(if (null external-symbols) "0 external symbols." From mbaringer at common-lisp.net Fri Sep 17 13:01:02 2004 From: mbaringer at common-lisp.net (Marco Baringer) Date: Fri, 17 Sep 2004 15:01:02 +0200 Subject: [slime-cvs] CVS update: slime/doc/slime.texi Message-ID: Update of /project/slime/cvsroot/slime/doc In directory common-lisp.net:/tmp/cvs-serv8318/doc Modified Files: slime.texi Log Message: Update inspector documentation. Date: Fri Sep 17 15:01:02 2004 Author: mbaringer Index: slime/doc/slime.texi diff -u slime/doc/slime.texi:1.29 slime/doc/slime.texi:1.30 --- slime/doc/slime.texi:1.29 Thu Sep 9 17:04:32 2004 +++ slime/doc/slime.texi Fri Sep 17 15:01:01 2004 @@ -47,10 +47,10 @@ <<<<<<< slime.texi @set EDITION 1.0 - at set UPDATED @code{$Date: 2004/09/09 15:04:32 $} + at set UPDATED @code{$Date: 2004/09/17 13:01:01 $} ======= @set EDITION 1.0 - at set UPDATED @code{$Date: 2004/09/09 15:04:32 $} + at set UPDATED @code{$Date: 2004/09/17 13:01:01 $} >>>>>>> 1.28 @titlepage @@ -697,8 +697,11 @@ @subsection Inspector The @SLIME{} inspector is an Emacs-based version of the Lisp function - at code{INSPECT}. The inspected object is presented in a buffer with one -line per slot. + at code{INSPECT} which uses an Emacs buffer to display, navigate and +operate on lisp objects. + +The inspector can be adapted to new objects by defining an appropiate +method on the generic function @code{SWANK:INSPECT-FOR-EMACS}. @table @kbd @kbditem{C-c I, slime-inspect} @@ -709,8 +712,9 @@ @table @kbd - at kbditem{RET, slime-inspector-inspect-object-at-point} -Inspect the slot at point. The inspector is invoked recursively. + at kbditem{RET, slime-inspector-operate-on-point} +If point is on a value then recursivly call the inspcetor on that +value. If point is on an action then call that action. @kbditem{d, slime-inspector-describe} Describe the slot at point. @@ -723,6 +727,9 @@ @kbditem{q, slime-inspector-quit} Dismiss the inspector buffer. + + at kbditem{M-RET, slime-inspector-copy-down} Evaluate the value under +point via the REPL (to set `*'). @end table From mbaringer at common-lisp.net Fri Sep 17 13:01:23 2004 From: mbaringer at common-lisp.net (Marco Baringer) Date: Fri, 17 Sep 2004 15:01:23 +0200 Subject: [slime-cvs] CVS update: slime/ChangeLog Message-ID: Update of /project/slime/cvsroot/slime In directory common-lisp.net:/tmp/cvs-serv8337 Modified Files: ChangeLog Log Message: Date: Fri Sep 17 15:01:22 2004 Author: mbaringer Index: slime/ChangeLog diff -u slime/ChangeLog:1.536 slime/ChangeLog:1.537 --- slime/ChangeLog:1.536 Thu Sep 16 17:58:52 2004 +++ slime/ChangeLog Fri Sep 17 15:01:19 2004 @@ -1,3 +1,35 @@ +2004-09-17 Marco Baringer + + * swank.lisp: Don't print "Documentation:" if none is available; + add support for classes specializer-direct-methods; deal with + eql-specializers in methods. + (inspector-princ): New function. + (method-specializers-for-inspect): New function. + (method-for-inspect-value): New function. + (inspect-for-emacs): Use inspector-princ instead of + princ-to-string. + + * swank-backend.lisp (swank-mop): Require eql-specializer, + eql-specializer-object and specializer-direct-methods in swank-mop + package. + + * swank-allegro.lisp, swank-clisp.lisp, swank-cmucl.lisp, + swank-openmcl.lisp, swank-sbcl.lisp (swank-mop): Export + eql-specializer, eql-specializer-object and + specializer-direct-methods from swank-mop. + + * swank-cmucl.lisp (inspect-for-emacs): Thinko fix. + + * swank-lispworks.lisp (swank-mop): Export + specializer-direct-methods. + (eql-specializer): Implement. + (eql-specializer-object): Implement. + + * swank-sbcl.lisp (inspect-for-emacs): Fix broken ignore + declaration. + + * doc/slime.texi: Update inspector documentation. + 2004-09-16 Marco Baringer * swank-clisp.lisp (swank-mop, inspect-for-emacs): Only define the From heller at common-lisp.net Sun Sep 19 05:50:42 2004 From: heller at common-lisp.net (Helmut Eller) Date: Sun, 19 Sep 2004 07:50:42 +0200 Subject: [slime-cvs] CVS update: slime/slime.el Message-ID: Update of /project/slime/cvsroot/slime In directory common-lisp.net:/tmp/cvs-serv12144 Modified Files: slime.el Log Message: (slime-repl-return-string): Allow empty strings. That's our way to send end-of-file. (sldb-insert-condition): Add "extra" slot for random thing that don't fit nicely somewhere else. (sldb-dispatch-extras extras): New function. (sldb-show-frame-source): New non-interactive version of sldb-show-source. (sldb-show-source): Use it. (sldb-break-on-return, sldb-break): New commands. (slime-beginning-of-symbol, slime-symbol-end-pos): New functions which don't include the character after a hash '#'. (slime-symbol-name-at-point): Use them. (slime-symbol-start-pos, slime-symbol-end-pos): Ditto. Date: Sun Sep 19 07:50:41 2004 Author: heller Index: slime/slime.el diff -u slime/slime.el:1.400 slime/slime.el:1.401 --- slime/slime.el:1.400 Wed Sep 15 19:26:52 2004 +++ slime/slime.el Sun Sep 19 07:50:40 2004 @@ -2807,7 +2807,6 @@ (slime-repl-read-mode 1)) (defun slime-repl-return-string (string) - (assert (plusp (length string))) (slime-dispatch-event `(:emacs-return-string ,(pop slime-read-string-threads) ,(pop slime-read-string-tags) @@ -4353,18 +4352,6 @@ (read-from-minibuffer prompt initial-value slime-read-expression-map nil 'slime-read-expression-history))) -(defun slime-symbol-start-pos () - "Return the starting position of the symbol under point. -The result is unspecified if there isn't a symbol under the point." - (save-excursion - (skip-syntax-backward "w_") - (point))) - -(defun slime-symbol-end-pos () - (save-excursion - (skip-syntax-forward "w_") - (point))) - (defun slime-bogus-completion-alist (list) "Make an alist out of list. The same elements go in the CAR, and nil in the CDR. To support the @@ -5632,6 +5619,7 @@ ("R" 'sldb-return-from-frame) ("c" 'sldb-continue) ("s" 'sldb-step) + ("b" 'sldb-break-on-return) ("a" 'sldb-abort) ("q" 'sldb-quit) ("B" 'sldb-break-with-default-debugger) @@ -5744,7 +5732,7 @@ (kill-buffer sldb)))) (defun sldb-insert-condition (condition) - (destructuring-bind (message type references) condition + (destructuring-bind (message type references extras) condition (slime-insert-propertized '(sldb-default-action sldb-inspect-condition) (in-sldb-face topline message) "\n" @@ -5754,7 +5742,8 @@ (insert "See also:\n") (slime-with-rigid-indentation 2 (sldb-insert-references references)) - (insert "\n")))) + (insert "\n")) + (sldb-dispatch-extras extras))) (defun sldb-insert-references (references) "Insert documentation references from a condition. @@ -5821,6 +5810,12 @@ (subst-char-in-string ?\ ?\- what)))) (browse-url url)))))) +(defun sldb-dispatch-extras (extras) + (dolist (extra extras) + (destructure-case extra + ((:short-frame-source n) + (sldb-show-frame-source n))))) + (defun sldb-insert-restarts (restarts) (loop for (name string) in restarts for number from 0 @@ -5939,17 +5934,19 @@ (defun sldb-show-source () "Highlight the frame at point's expression in a source code buffer." (interactive) + (sldb-show-frame-source (sldb-frame-number-at-point))) + +(defun sldb-show-frame-source (frame-number) (sldb-delete-overlays) - (let* ((number (sldb-frame-number-at-point))) - (slime-eval-async - `(swank:frame-source-location-for-emacs ,number) - (lambda (source-location) - (destructure-case source-location - ((:error message) - (message "%s" message) - (ding)) - (t - (slime-show-source-location source-location))))))) + (slime-eval-async + `(swank:frame-source-location-for-emacs ,frame-number) + (lambda (source-location) + (destructure-case source-location + ((:error message) + (message "%s" message) + (ding)) + (t + (slime-show-source-location source-location)))))) (defun slime-show-source-location (source-location) (slime-goto-source-location source-location) @@ -6244,6 +6241,20 @@ (let ((frame (sldb-frame-number-at-point))) (slime-eval-async `(swank:sldb-step ,frame)))) +(defun sldb-break-on-return () + "Set a breakpoint at the current frame. +The debugger is entered when the frame exits." + (interactive) + (let ((frame (sldb-frame-number-at-point))) + (slime-eval-async `(swank:sldb-break-on-return ,frame) + (lambda (msg) (message "%s" msg))))) + +(defun sldb-break (name) + "Set a breakpoint at the start of the function NAME." + (interactive (list (slime-read-symbol-name "Function: " t))) + (slime-eval-async `(swank:sldb-break ,name) + (lambda (msg) (message "%s" msg)))) + (defun sldb-disassemble () "Disassemble the code for the current frame." (interactive) @@ -7636,6 +7647,27 @@ (beginning-of-defun) (buffer-substring-no-properties (point) end)))) +(defun slime-beginning-of-symbol () + "Move point to the beginning of the current symbol." + (and (minusp (skip-syntax-backward "w_")) + (when (eq (char-before) ?#) ; special case for things like "#= (point) slime-repl-input-start-mark)) (narrow-to-region slime-repl-input-start-mark (point-max))) (save-excursion - (skip-syntax-forward "w_") - (skip-syntax-backward "-") - (let ((string (thing-at-point 'symbol))) + (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 From heller at common-lisp.net Sun Sep 19 05:52:49 2004 From: heller at common-lisp.net (Helmut Eller) Date: Sun, 19 Sep 2004 07:52:49 +0200 Subject: [slime-cvs] CVS update: slime/swank-backend.lisp Message-ID: Update of /project/slime/cvsroot/slime In directory common-lisp.net:/tmp/cvs-serv12177 Modified Files: swank-backend.lisp Log Message: (import-swank-mop-symbols): New function. Useful if the implementation has most of the mop symbols in the same package. (sldb-break-on-return, sldb-break-at-start, condition-extras): New functions. Date: Sun Sep 19 07:52:49 2004 Author: heller Index: slime/swank-backend.lisp diff -u slime/swank-backend.lisp:1.68 slime/swank-backend.lisp:1.69 --- slime/swank-backend.lisp:1.68 Fri Sep 17 14:49:04 2004 +++ slime/swank-backend.lisp Sun Sep 19 07:52:48 2004 @@ -81,14 +81,6 @@ #:slot-definition-readers #:slot-definition-writers)) -(defun swank-backend::import-to-swank-mop (symbol-list) - (dolist (sym symbol-list) - (let* ((swank-mop-sym (find-symbol (symbol-name sym) :swank-mop))) - (when swank-mop-sym - (unintern swank-mop-sym :swank-mop)) - (import sym :swank-mop) - (export sym :swank-mop)))) - (in-package :swank-backend) @@ -138,6 +130,25 @@ (warn "These Swank interfaces are unimplemented:~% ~A" (sort (copy-list *unimplemented-interfaces*) #'string<))) +(defun import-to-swank-mop (symbol-list) + (dolist (sym symbol-list) + (let* ((swank-mop-sym (find-symbol (symbol-name sym) :swank-mop))) + (when swank-mop-sym + (unintern swank-mop-sym :swank-mop)) + (import sym :swank-mop) + (export sym :swank-mop)))) + +(defun import-swank-mop-symbols (package except) + "Import the mop symbols from PACKAGE to SWANK-MOP. +EXCEPT is a list of symbol names which should be ignored." + (do-symbols (s :swank-mop) + (unless (member s except :test #'string=) + (let ((real-symbol (find-symbol (string s) package))) + (assert real-symbol) + (unintern s :swank-mop) + (import real-symbol :swank-mop) + (export real-symbol :swank-mop))))) + ;;;; Utilities @@ -490,8 +501,20 @@ (:SBCL :NODE node-name)" '()) +(definterface condition-extras (condition) + "Return a list of extra for the debugger. +The allowed elements are of the form: + (:SHOW-FRAME-SOURCE frame-number)" + '()) + (definterface sldb-step (frame-number) - "Step to the next code location in the frame FRAME-NUMBER.") + "Step to the next code location in the frame FRAME-NUMBER.") + +(definterface sldb-break-on-return (frame-number) + "Set a breakpoint in the frame FRAME-NUMBER.") + +(definterface sldb-break-at-start (symbol) + "Set a breakpoint on the beginning of the function for SYMBOL.") From heller at common-lisp.net Sun Sep 19 05:56:43 2004 From: heller at common-lisp.net (Helmut Eller) Date: Sun, 19 Sep 2004 07:56:43 +0200 Subject: [slime-cvs] CVS update: slime/swank.lisp Message-ID: Update of /project/slime/cvsroot/slime In directory common-lisp.net:/tmp/cvs-serv14191 Modified Files: swank.lisp Log Message: (thread-for-evaluation): Restart the listener thread if it was dead for some reason. (debugger-condition-for-emacs): Include "extra" stuff. (sldb-break): New entry function. Date: Sun Sep 19 07:56:42 2004 Author: heller Index: slime/swank.lisp diff -u slime/swank.lisp:1.239 slime/swank.lisp:1.240 --- slime/swank.lisp:1.239 Fri Sep 17 14:52:11 2004 +++ slime/swank.lisp Sun Sep 19 07:56:42 2004 @@ -35,6 +35,8 @@ #:frame-source-location-for-emacs #:restart-frame #:sldb-step + #:sldb-break + #:sldb-break-on-return #:profiled-functions #:profile-report #:profile-reset @@ -455,7 +457,12 @@ ((member t) (spawn (lambda () (handle-request c)) :name "worker")) ((member :repl-thread) - (connection.repl-thread c)) + (let ((thread (connection.repl-thread c)) ) + (if (thread-alive-p thread) + thread + (setf (connection.repl-thread c) + (spawn (lambda () (repl-loop c)) + :name "new-repl-thread"))))) (fixnum (find-thread id))))) @@ -914,7 +921,7 @@ This is like defvar, but NAME will not be initialized." `(progn (defvar ,name) - (setf (documentation ',name 'variable) ',doc))) + (setf (documentation ',name 'variable) ,doc))) (define-special *buffer-package* "Package corresponding to slime-buffer-package. @@ -1352,7 +1359,8 @@ (list (safe-condition-message *swank-debugger-condition*) (format nil " [Condition of type ~S]" (type-of *swank-debugger-condition*)) - (condition-references *swank-debugger-condition*))) + (condition-references *swank-debugger-condition*) + (condition-extras *swank-debugger-condition*))) (defun format-restarts-for-emacs () "Return a list of restarts for *swank-debugger-condition* in a @@ -1388,11 +1396,12 @@ The result is a list: (condition ({restart}*) ({stack-frame}*) where - condition ::= (description type) + condition ::= (description type [extra]) restart ::= (name description) stack-frame ::= (number description) - -condition---a pair of strings: message, and type. + extra ::= (:references +condition---a pair of strings: message, and type. If show-source is +not nil it is a frame number for which the source should be displayed. restart---a pair of strings: restart name, and description. @@ -1470,6 +1479,10 @@ (defslimefun sldb-return-from-frame (index string) (let ((form (from-string string))) (to-string (multiple-value-list (return-from-frame index form))))) + +(defslimefun sldb-break (name) + (with-buffer-syntax () + (sldb-break-at-start (read-from-string name)))) ;;;; Compilation Commands. From heller at common-lisp.net Sun Sep 19 06:10:00 2004 From: heller at common-lisp.net (Helmut Eller) Date: Sun, 19 Sep 2004 08:10:00 +0200 Subject: [slime-cvs] CVS update: slime/swank-cmucl.lisp Message-ID: Update of /project/slime/cvsroot/slime In directory common-lisp.net:/tmp/cvs-serv20096 Modified Files: swank-cmucl.lisp Log Message: (sis/in): Treat empty strings as end-of-file. (map-allocated-code-components): Inhibit efficiency notes. (arglist)[symbol] Delete unreachable code. (sldb-break-on-return, sldb-break-at-start): Implement it (sldb-step): Some cleanups. Date: Sun Sep 19 08:10:00 2004 Author: heller Index: slime/swank-cmucl.lisp diff -u slime/swank-cmucl.lisp:1.118 slime/swank-cmucl.lisp:1.119 --- slime/swank-cmucl.lisp:1.118 Fri Sep 17 14:50:08 2004 +++ slime/swank-cmucl.lisp Sun Sep 19 08:10:00 2004 @@ -8,6 +8,11 @@ (in-package :swank-backend) +(import-swank-mop-symbols :pcl '(:slot-definition-documentation)) + +(defun swank-mop:slot-definition-documentation (slot) + (documentation slot t)) + ;;;; "Hot fixes" ;;; ;;; Here are necessary bugfixes to the latest released version of @@ -17,54 +22,6 @@ ;;; promptly delete them from here. It is enough to be compatible with ;;; the latest release. -(import-to-swank-mop - '( ;; classes - cl:standard-generic-function - pcl:standard-slot-definition - cl:method - cl:standard-class - pcl:eql-specializer - ;; standard-class readers - pcl:class-default-initargs - pcl:class-direct-default-initargs - pcl:class-direct-slots - pcl:class-direct-subclasses - pcl:class-direct-superclasses - pcl:class-finalized-p - cl:class-name - pcl:class-precedence-list - pcl:class-prototype - pcl:class-slots - pcl:specializer-direct-methods - ;; eql-specializer accessors - pcl:eql-specializer-object - ;; generic function readers - pcl:generic-function-argument-precedence-order - pcl:generic-function-declarations - pcl:generic-function-lambda-list - pcl:generic-function-methods - pcl:generic-function-method-class - pcl:generic-function-method-combination - pcl:generic-function-name - ;; method readers - pcl:method-generic-function - pcl:method-function - pcl:method-lambda-list - pcl:method-specializers - pcl:method-qualifiers - ;; slot readers - pcl:slot-definition-allocation - pcl:slot-definition-initargs - pcl:slot-definition-initform - pcl:slot-definition-initfunction - pcl:slot-definition-name - pcl:slot-definition-type - pcl:slot-definition-readers - pcl:slot-definition-writers)) - -(defun swank-mop:slot-definition-documentation (slot) - (documentation slot t)) - (in-package :lisp) ;;; `READ-SEQUENCE' with large sequences has problems in 18e. This new @@ -230,7 +187,8 @@ (setf (sos.index stream) (1+ index)) (incf (sos.column stream)) (when (char= #\newline char) - (setf (sos.column stream) 0)) + (setf (sos.column stream) 0) + (force-output stream)) (when (= index (1- (length buffer))) (force-output stream))) char) @@ -270,14 +228,20 @@ (index 0 :type kernel:index)) (defun sis/in (stream eof-errorp eof-value) - (declare (ignore eof-errorp eof-value)) (let ((index (sis.index stream)) (buffer (sis.buffer stream))) (when (= index (length buffer)) (force-output (sis.sos stream)) - (setf buffer (funcall (sis.input-fn stream))) - (setf (sis.buffer stream) buffer) - (setf index 0)) + (let ((string (funcall (sis.input-fn stream)))) + (cond ((zerop (length string)) + (return-from sis/in + (if eof-errorp + (error (make-condition 'end-of-file :stream stream)) + eof-value))) + (t + (setf buffer string) + (setf (sis.buffer stream) buffer) + (setf index 0))))) (prog1 (aref buffer index) (setf (sis.index stream) (1+ index))))) @@ -545,7 +509,8 @@ receives the object as argument. SPACES should be a list of the symbols :dynamic, :static, or :read-only." (dolist (space spaces) - (declare (inline vm::map-allocated-objects)) + (declare (inline vm::map-allocated-objects) + (optimize (ext:inhibit-warnings 3))) (vm::map-allocated-objects (lambda (obj header size) (declare (type fixnum size) (ignore size)) @@ -595,7 +560,7 @@ (list (list name (make-location (list :file (unix-truename (c::debug-source-name first))) - (list :function-name name))))))))) + (list :function-name (string name)))))))))) (defun code-component-entry-points (code) "Return a list ((NAME LOCATION) ...) of function definitons for @@ -755,11 +720,11 @@ (ecase from (:file (make-location (list :file (namestring (truename name))) - (list :function-name fname))) + (list :function-name (string fname)))) (:stream (assert (debug-source-info-from-emacs-buffer-p (car source))) (make-location (list :buffer (getf info :emacs-buffer)) - (list :function-name fname))) + (list :function-name (string fname)))) (:lisp (make-location (list :source-form (princ-to-string (aref name 0))) (list :position 1))))))) @@ -1117,7 +1082,7 @@ (unix-truename (merge-pathnames (make-pathname :type "lisp") file))) (cond (filename (make-location `(:file ,filename) - `(:function-name ,string))) + `(:function-name ,(string string)))) (t (list :error (princ-to-string c)))))) (defun source-location-form-numbers (location) @@ -1332,9 +1297,8 @@ ;;;;; Argument lists (defimplementation arglist ((name symbol)) - (arglist (or (macro-function name) - (symbol-function name) - (error "~S does not name a known function.")))) + (arglist (or (symbol-macro name) + (symbol-function name)))) (defimplementation arglist ((fun function)) (let ((arglist @@ -1575,45 +1539,177 @@ (defimplementation frame-catch-tags (index) (mapcar #'car (di:frame-catches (nth-frame index)))) -(defun set-step-breakpoints (frame) - (when (di:debug-block-elsewhere-p (di:code-location-debug-block - (di:frame-code-location frame))) - (error "Cannot step, in elsewhere code~%")) - (let* ((code-location (di:frame-code-location frame)) - (debug::*bad-code-location-types* - (remove :call-site debug::*bad-code-location-types*)) - (next (debug::next-code-locations code-location))) - (cond (next - (let ((steppoints '())) - (flet ((hook (frame breakpoint) - (let ((debug:*stack-top-hint* frame)) - (mapc #'di:delete-breakpoint steppoints) - (let ((cl (di::breakpoint-what breakpoint))) - (break "Breakpoint: ~S ~S" - (di:code-location-kind cl) - (di::compiled-code-location-pc cl)))))) - (dolist (code-location next) - (let ((bp (di:make-breakpoint #'hook code-location - :kind :code-location))) - (di:activate-breakpoint bp) - (push bp steppoints)))))) - (t - (flet ((hook (frame breakpoint values cookie) - (declare (ignore cookie)) - (di:delete-breakpoint breakpoint) - (let ((debug:*stack-top-hint* frame)) - (break "Function-end: ~A ~A" breakpoint values)))) - (let* ((debug-function (di:frame-debug-function frame)) - (bp (di:make-breakpoint #'hook debug-function - :kind :function-end))) - (di:activate-breakpoint bp))))))) - (defimplementation sldb-step (frame) (cond ((find-restart 'continue) (set-step-breakpoints (nth-frame frame)) (continue)) (t (error "No continue restart.")))) + +(defimplementation sldb-break-on-return (frame) + (break-on-return (nth-frame frame))) + +;;; We set the breakpoint the caller which might be a bit confusing. +;;; +(defun break-on-return (frame) + (let* ((caller (di:frame-down frame)) + (cl (di:frame-code-location caller))) + (flet ((hook (frame bp) + (when (frame-pointer= frame caller) + (di:delete-breakpoint bp) + (signal-breakpoint bp frame)))) + (let* ((info (ecase (di:code-location-kind cl) + ((:single-value-return :unknown-return) nil) + (:known-return (debug-function-returns + (di:frame-debug-function frame))))) + (bp (di:make-breakpoint #'hook cl :kind :code-location + :info info))) + (di:activate-breakpoint bp) + `(:ok ,(format nil "Set breakpoint in ~A" caller)))))) + +(defun frame-pointer= (frame1 frame2) + "Return true if the frame pointers of FRAME1 and FRAME2 are the same." + (sys:sap= (di::frame-pointer frame1) (di::frame-pointer frame2))) + +(defun set-step-breakpoints (frame) + (let ((cl (di:frame-code-location frame))) + (when (di:debug-block-elsewhere-p (di:code-location-debug-block cl)) + (error "Cannot step in elsewhere code")) + (let* ((debug::*bad-code-location-types* + (remove :call-site debug::*bad-code-location-types*)) + (next (debug::next-code-locations cl))) + (cond (next + (let ((steppoints '())) + (flet ((hook (bp-frame bp) + (mapc #'di:delete-breakpoint steppoints) + (signal-breakpoint bp bp-frame))) + (dolist (code-location next) + (let ((bp (di:make-breakpoint #'hook code-location + :kind :code-location))) + (di:activate-breakpoint bp) + (push bp steppoints)))))) + (t + (break-on-return frame)))))) + + +;; XXX the return values at return breakpoints should be passed to the +;; user hooks. debug-int.lisp should be changed to do this cleanly. + +;;; The sigcontext and the PC for a breakpoint invocation are not +;;; passed to user hook functions, but we need them to extract return +;;; values. So we advice di::handle-breakpoint and bind the values to +;;; special variables. +;;; +(defvar *breakpoint-sigcontext*) +(defvar *breakpoint-pc*) + +;; XXX don't break old versions without fwrappers. Remove this one day. +#+#.(cl:if (cl:find-package :fwrappers) '(and) '(or)) +(progn + (fwrappers:define-fwrapper bind-breakpoint-sigcontext (offset c sigcontext) + (let ((*breakpoint-sigcontext* sigcontext) + (*breakpoint-pc* offset)) + (fwrappers:call-next-function))) + (fwrappers:set-fwrappers 'di::handle-breakpoint '()) + (fwrappers:fwrap 'di::handle-breakpoint #'bind-breakpoint-sigcontext)) + +(defun sigcontext-object (sc index) + "Extract the lisp object in sigcontext SC at offset INDEX." + (kernel:make-lisp-obj (vm:sigcontext-register sc index))) + +(defun known-return-point-values (sigcontext sc-offsets) + (let ((fp (system:int-sap (vm:sigcontext-register sigcontext + vm::cfp-offset)))) + (system:without-gcing + (loop for sc-offset across sc-offsets + collect (di::sub-access-debug-var-slot fp sc-offset sigcontext))))) + +;;; CMUCL returns the first few values in registers and the rest on +;;; the stack. In the multiple value case, the number of values is +;;; stored in a dedicated register. The values of the registers can be +;;; accessed in the sigcontext for the breakpoint. There are 3 kinds +;;; of return conventions: :single-value-return, :unknown-return, and +;;; :known-return. +;;; +;;; The :single-value-return convention returns the value in a +;;; register without setting the nargs registers. +;;; +;;; The :unknown-return variant is used for multiple values. A +;;; :unknown-return point consists actually of 2 breakpoints: one for +;;; the single value case and one for the general case. The single +;;; value breakpoint comes vm:single-value-return-byte-offset after +;;; the multiple value breakpoint. +;;; +;;; The :known-return convention is used by local functions. +;;; :known-return is currently not supported because we don't know +;;; where the values are passed. +;;; +(defun breakpoint-values (breakpoint) + "Return the list of return values for a return point." + (flet ((1st (sc) (sigcontext-object sc (car vm::register-arg-offsets)))) + (let ((sc (locally (declare (optimize (ext:inhibit-warnings 3))) + (alien:sap-alien *breakpoint-sigcontext* (* unix:sigcontext)))) + (cl (di:breakpoint-what breakpoint))) + (ecase (di:code-location-kind cl) + (:single-value-return + (list (1st sc))) + (:known-return + (let ((info (di:breakpoint-info breakpoint))) + (if (vectorp info) + (known-return-point-values sc info) + (list "<>")))) + (:unknown-return + (let ((mv-return-pc (di::compiled-code-location-pc cl))) + (if (= mv-return-pc *breakpoint-pc*) + (di::get-function-end-breakpoint-values sc) + (list (1st sc))))))))) + +(defun debug-function-returns (debug-fun) + "Return the return style of DEBUG-FUN." + (let* ((cdfun (di::compiled-debug-function-compiler-debug-fun debug-fun))) + (c::compiled-debug-function-returns cdfun))) + +(define-condition breakpoint (simple-condition) + ((message :initarg :message :reader breakpoint.message)) + (:report (lambda (c stream) (princ (breakpoint.message c) stream)))) + +(defimplementation condition-extras ((c breakpoint)) + ;; simply pop up the source buffer + `((:short-frame-source 0))) + +(defun signal-breakpoint (breakpoint frame) + "Signal a breakpoint condition for BREAKPOINT in FRAME. +Try to create a informative message." + (flet ((brk (fstring &rest args) + (let ((msg (apply #'format nil fstring args)) + (debug:*stack-top-hint* frame)) + (break 'breakpoint :message msg)))) + (with-struct (di::breakpoint- kind what) breakpoint + (case kind + (:code-location + (case (di:code-location-kind what) + ((:single-value-return :known-return :unknown-return) + (brk "Return value: ~{~S ~}" (breakpoint-values breakpoint))) + (t + (brk "Breakpoint: ~S ~S" + (di:code-location-kind what) + (di::compiled-code-location-pc what))))) + (:function-start + (brk "Function start breakpoint")) + (t (brk "Breakpoint: ~A in ~A" breakpoint frame)))))) + +(defimplementation sldb-break-at-start (fname) + (let ((debug-fun (di:function-debug-function (coerce fname 'function)))) + (cond ((not debug-fun) + `(:error ,(format nil "~S has no debug-function" fname))) + (t + (flet ((hook (frame bp &optional args cookie) + (declare (ignore args cookie)) + (signal-breakpoint bp frame))) + (let ((bp (di:make-breakpoint #'hook debug-fun + :kind :function-start))) + (di:activate-breakpoint bp) + `(:ok ,(format nil "Set breakpoint in ~S" fname)))))))) (defun frame-cfp (frame) "Return the Control-Stack-Frame-Pointer for FRAME." From heller at common-lisp.net Sun Sep 19 06:11:15 2004 From: heller at common-lisp.net (Helmut Eller) Date: Sun, 19 Sep 2004 08:11:15 +0200 Subject: [slime-cvs] CVS update: slime/swank-gray.lisp Message-ID: Update of /project/slime/cvsroot/slime In directory common-lisp.net:/tmp/cvs-serv20138 Modified Files: swank-gray.lisp Log Message: (stream-read-char): Treat empty strings as end-of-file. Date: Sun Sep 19 08:11:14 2004 Author: heller Index: slime/swank-gray.lisp diff -u slime/swank-gray.lisp:1.5 slime/swank-gray.lisp:1.6 --- slime/swank-gray.lisp:1.5 Tue Mar 9 20:35:36 2004 +++ slime/swank-gray.lisp Sun Sep 19 08:11:14 2004 @@ -2,7 +2,7 @@ ;;; ;;; swank-gray.lisp --- Gray stream based IO redirection. ;;; -;;; Created 2003, Helmut Eller +;;; Created 2003 ;;; ;;; This code has been placed in the Public Domain. All warranties ;;; are disclaimed. @@ -51,8 +51,12 @@ (when (= index (length buffer)) (when output-stream (force-output output-stream)) - (setf buffer (funcall input-fn)) - (setf index 0)) + (let ((string (funcall input-fn))) + (cond ((zerop (length string)) + (return-from stream-read-char :eof)) + (t + (setf buffer string) + (setf index 0))))) (assert (plusp (length buffer))) (prog1 (aref buffer index) (incf index)))) From heller at common-lisp.net Sun Sep 19 06:17:20 2004 From: heller at common-lisp.net (Helmut Eller) Date: Sun, 19 Sep 2004 08:17:20 +0200 Subject: [slime-cvs] CVS update: slime/swank-cmucl.lisp Message-ID: Update of /project/slime/cvsroot/slime In directory common-lisp.net:/tmp/cvs-serv21034 Modified Files: swank-cmucl.lisp Log Message: *** empty log message *** Date: Sun Sep 19 08:17:19 2004 Author: heller Index: slime/swank-cmucl.lisp diff -u slime/swank-cmucl.lisp:1.119 slime/swank-cmucl.lisp:1.120 --- slime/swank-cmucl.lisp:1.119 Sun Sep 19 08:10:00 2004 +++ slime/swank-cmucl.lisp Sun Sep 19 08:17:19 2004 @@ -1297,7 +1297,7 @@ ;;;;; Argument lists (defimplementation arglist ((name symbol)) - (arglist (or (symbol-macro name) + (arglist (or (macro-function name) (symbol-function name)))) (defimplementation arglist ((fun function)) From heller at common-lisp.net Sun Sep 19 07:57:57 2004 From: heller at common-lisp.net (Helmut Eller) Date: Sun, 19 Sep 2004 09:57:57 +0200 Subject: [slime-cvs] CVS update: slime/swank.lisp Message-ID: Update of /project/slime/cvsroot/slime In directory common-lisp.net:/tmp/cvs-serv14894 Modified Files: swank.lisp Log Message: (interrupt-worker-thread): Interrupt the repl thread if there is no other active thread. Date: Sun Sep 19 09:57:54 2004 Author: heller Index: slime/swank.lisp diff -u slime/swank.lisp:1.240 slime/swank.lisp:1.241 --- slime/swank.lisp:1.240 Sun Sep 19 07:56:42 2004 +++ slime/swank.lisp Sun Sep 19 09:57:54 2004 @@ -440,14 +440,26 @@ (loop (with-simple-restart (abort "Restart dispatch loop.") (loop (dispatch-event (receive) socket-io)))))) +(defun repl-thread (connection) + (let ((thread (connection.repl-thread connection))) + (if (thread-alive-p thread) + thread + (setf (connection.repl-thread connection) + (spawn (lambda () (repl-loop connection)) + :name "new-repl-thread"))))) + +(defun find-worker-thread (id) + (etypecase id + ((member t) + (car *active-threads*)) + ((member :repl-thread) + (repl-thread *emacs-connection*)) + (fixnum + (find-thread id)))) + (defun interrupt-worker-thread (id) - (let ((thread (etypecase id - ((member t) - (car *active-threads*)) - ((member :repl-thread) - (connection.repl-thread *emacs-connection*)) - (fixnum - (find-thread id))))) + (let ((thread (or (find-worker-thread id) + (repl-thread *emacs-connection*)))) (interrupt-thread thread #'simple-break))) (defun thread-for-evaluation (id) @@ -457,12 +469,7 @@ ((member t) (spawn (lambda () (handle-request c)) :name "worker")) ((member :repl-thread) - (let ((thread (connection.repl-thread c)) ) - (if (thread-alive-p thread) - thread - (setf (connection.repl-thread c) - (spawn (lambda () (repl-loop c)) - :name "new-repl-thread"))))) + (repl-thread c)) (fixnum (find-thread id))))) @@ -499,10 +506,12 @@ (defun spawn-threads-for-connection (connection) (let* ((socket-io (connection.socket-io connection)) (control-thread (spawn (lambda () + (setq *debugger-hook* nil) (dispatch-loop socket-io connection)) :name "control-thread"))) (setf (connection.control-thread connection) control-thread) (let ((reader-thread (spawn (lambda () + (setq *debugger-hook* nil) (read-loop control-thread socket-io connection)) :name "reader-thread")) From heller at common-lisp.net Sun Sep 19 08:04:58 2004 From: heller at common-lisp.net (Helmut Eller) Date: Sun, 19 Sep 2004 10:04:58 +0200 Subject: [slime-cvs] CVS update: slime/ChangeLog Message-ID: Update of /project/slime/cvsroot/slime In directory common-lisp.net:/tmp/cvs-serv18053 Modified Files: ChangeLog Log Message: *** empty log message *** Date: Sun Sep 19 10:04:57 2004 Author: heller Index: slime/ChangeLog diff -u slime/ChangeLog:1.537 slime/ChangeLog:1.538 --- slime/ChangeLog:1.537 Fri Sep 17 15:01:19 2004 +++ slime/ChangeLog Sun Sep 19 10:04:57 2004 @@ -1,3 +1,42 @@ +2004-09-19 Helmut Eller + + * swank-gray.lisp (stream-read-char): Treat empty strings as + end-of-file. + + * swank-cmucl.lisp (sis/in): Treat empty strings as end-of-file. + (map-allocated-code-components): Inhibit efficiency notes. + (arglist)[symbol] Delete unreachable code. + (sldb-break-on-return, sldb-break-at-start): Implement it + (sldb-step): Some cleanups. + + * swank.lisp (thread-for-evaluation): Restart the listener thread + if it was dead for some reason. + (debugger-condition-for-emacs): Include "extra" stuff. Currenlty + only used to pop up the source buffer at breakpoints. + (sldb-break): New function. + (interrupt-worker-thread): Interrupt the repl thread if there is + no other active thread. + + * swank-backend.lisp (import-swank-mop-symbols): New + function. Useful if the implementation has most of the mop symbols + in the same package. + (sldb-break-on-return, sldb-break-at-start, condition-extras): New + functions. + + * slime.el (sldb-break-on-return, sldb-break): New commands. + (slime-repl-return-string): Allow empty strings. That's our way + to send end-of-file. + (sldb-insert-condition): Add "extra" slot for random thing that + don't fit nicely somewhere else. + (sldb-dispatch-extras): New function. + (sldb-show-frame-source): New non-interactive version of + sldb-show-source. + (sldb-show-source): Use it. + (slime-beginning-of-symbol, slime-end-of-symbol): New functions + which don't include the character after a hash '#'. + (slime-symbol-name-at-point): Use them. + (slime-symbol-start-pos, slime-symbol-end-pos): Ditto. + 2004-09-17 Marco Baringer * swank.lisp: Don't print "Documentation:" if none is available; From asimon at common-lisp.net Mon Sep 20 13:30:36 2004 From: asimon at common-lisp.net (Andras Simon) Date: Mon, 20 Sep 2004 15:30:36 +0200 Subject: [slime-cvs] CVS update: slime/swank-abcl.lisp Message-ID: Update of /project/slime/cvsroot/slime In directory common-lisp.net:/tmp/cvs-serv18929 Modified Files: swank-abcl.lisp Log Message: swank-mop & inspector Date: Mon Sep 20 15:30:32 2004 Author: asimon Index: slime/swank-abcl.lisp diff -u slime/swank-abcl.lisp:1.16 slime/swank-abcl.lisp:1.17 --- slime/swank-abcl.lisp:1.16 Wed Sep 15 00:42:52 2004 +++ slime/swank-abcl.lisp Mon Sep 20 15:30:30 2004 @@ -14,8 +14,8 @@ (eval-when (:compile-toplevel :load-toplevel :execute) (require :collect) ;just so that it doesn't spoil the flying letters (require :gray-streams) - (require :pprint) - ) + (require :pprint)) + (import '(gs:fundamental-character-output-stream @@ -42,6 +42,7 @@ (defun slot-definition-type (slot) t) (defun class-prototype (class)) (defun generic-function-declarations (gf)) +(defun specializer-direct-methods (spec) nil) (import-to-swank-mop '( ;; classes @@ -55,11 +56,15 @@ sys::class-direct-slots sys::class-direct-subclasses sys::class-direct-superclasses + sys::eql-specializer class-finalized-p ;;dummy cl:class-name sys::class-precedence-list class-prototype ;;dummy sys::class-slots + specializer-direct-methods ;;dummy + ;; eql-specializer accessors + sys::eql-specializer-object ;; generic function readers sys::generic-function-argument-precedence-order generic-function-declarations ;;dummy @@ -132,11 +137,12 @@ ;;;; Misc -(defimplementation arglist ((symbol symbol)) - (handler-case (sys::arglist symbol) - (simple-error () :not-available))) +(defimplementation arglist ((symbol t)) + (multiple-value-bind (arglist present) + (sys::arglist symbol) + (if present arglist :not-available))) + -;;It's a string, not a symbol, but this is better than nothing. (defimplementation function-name (function) (nth-value 2 (function-lambda-expression function))) @@ -323,11 +329,14 @@ (defimplementation find-definitions (symbol) (source-location symbol)) +#| +Uncomment this if you have patched xref.lisp, as in +http://article.gmane.org/gmane.lisp.slime.devel/2425 +Also, make sure that xref.lisp is loaded by modifying the armedbear +part of *sysdep-pathnames* in swank.loader.lisp. -#| -Should work (with a patched xref.lisp) but is it any use without find-definitions? ;;;; XREF -(setq pxref::*handle-package-forms* '(cl:in-package)) +(setq pxref:*handle-package-forms* '(cl:in-package)) (defmacro defxref (name function) `(defimplementation ,name (name) @@ -343,9 +352,8 @@ (defun xref-results (symbols) (let ((xrefs '())) (dolist (symbol symbols) - (push (list symbol (fspec-location symbol)) xrefs)) + (push (list symbol (cadar (source-location symbol))) xrefs)) xrefs)) - |# ;;;; Inspecting @@ -375,14 +383,18 @@ (defmethod inspect-for-emacs ((f function) (inspector abcl-inspector)) (declare (ignore inspector)) (values "A function." - `("Name: " (:value ,(function-name f)) (:newline) - "Argument list: " ,(princ-to-string (sys::arglist f)) + `(,@(when (function-name f) + `("Name: " + ,(princ-to-string (function-name f)) (:newline))) + ,@(multiple-value-bind (args present) + (sys::arglist f) + (when present `("Argument list: " ,(princ-to-string args) (:newline)))) (:newline) #+nil,@(when (documentation f t) `("Documentation:" (:newline) ,(documentation f t) (:newline))) ,@(when (function-lambda-expression f) `("Lambda expression:" - (:newline) ,(prin1-to-string (function-lambda-expression f)) (:newline)))))) + (:newline) ,(princ-to-string (function-lambda-expression f)) (:newline)))))) #| From asimon at common-lisp.net Mon Sep 20 23:42:37 2004 From: asimon at common-lisp.net (Andras Simon) Date: Tue, 21 Sep 2004 01:42:37 +0200 Subject: [slime-cvs] CVS update: slime/swank-abcl.lisp Message-ID: Update of /project/slime/cvsroot/slime In directory common-lisp.net:/tmp/cvs-serv7637 Modified Files: swank-abcl.lisp Log Message: Redefine xp::decode-stream-arg Date: Tue Sep 21 01:42:36 2004 Author: asimon Index: slime/swank-abcl.lisp diff -u slime/swank-abcl.lisp:1.17 slime/swank-abcl.lisp:1.18 --- slime/swank-abcl.lisp:1.17 Mon Sep 20 15:30:30 2004 +++ slime/swank-abcl.lisp Tue Sep 21 01:42:36 2004 @@ -16,6 +16,14 @@ (require :gray-streams) (require :pprint)) +(defun xp::decode-stream-arg (stream) + (cond ((eq stream t) + *terminal-io*) + ((null stream) + *standard-output*) + ((gs::two-way-stream-g-p stream) + (gs::two-way-stream-output-stream stream)) + (t stream))) (import '(gs:fundamental-character-output-stream From heller at common-lisp.net Thu Sep 23 21:18:05 2004 From: heller at common-lisp.net (Helmut Eller) Date: Thu, 23 Sep 2004 23:18:05 +0200 Subject: [slime-cvs] CVS update: slime/slime.el Message-ID: Update of /project/slime/cvsroot/slime In directory common-lisp.net:/tmp/cvs-serv30262 Modified Files: slime.el Log Message: (slime-start-and-load): Take arguments so that the function can be called non-interactively. (slime-recompile-bytecode): Don't warn about uses of cl-functions. (slime-reset): Kill all sldb buffers. (slime-goto-location-position): Fix syntax for Emacs 20. (sldb-mode-map): Add C-c C-d bindings. (slime-open-inspector): Insert the type in the second line so that we can make longer titles, e.g we should include the princed version of the inspected object. Date: Thu Sep 23 23:18:05 2004 Author: heller Index: slime/slime.el diff -u slime/slime.el:1.401 slime/slime.el:1.402 --- slime/slime.el:1.401 Sun Sep 19 07:50:40 2004 +++ slime/slime.el Thu Sep 23 23:18:04 2004 @@ -1183,21 +1183,21 @@ (slime-hide-inferior-lisp-buffer) (message "Connected. %s" (slime-random-words-of-encouragement)))) -(defun slime-start-and-load () +(defun slime-start-and-load (filename &optional package) "Start Slime, load the current file and set the package." - (interactive) - (let ((package (slime-find-buffer-package))) - (when (not package) - (error "No package to load")) - (lexical-let ((hook nil) - (package package) - (filename (expand-file-name (buffer-file-name)))) - (setq hook (lambda () - (remove-hook 'slime-connected-hook hook) - (slime-load-file filename) - (slime-repl-set-package package))) - (add-hook 'slime-connected-hook hook) - (slime)))) + (interactive (list (expand-file-name (buffer-file-name)) + (slime-find-buffer-package))) + (lexical-let ((hook nil) (package package) + (filename (slime-to-lisp-filename filename))) + (setq hook (lambda () + (remove-hook 'slime-connected-hook hook) + (slime-eval-async + `(swank:load-file ,filename) + (lambda (result) + (when package + (slime-repl-set-package package)))))) + (add-hook 'slime-connected-hook hook) + (slime))) ;;;;; Start inferior lisp ;;; @@ -1232,8 +1232,11 @@ (defun slime-recompile-bytecode () "Recompile and reload slime. Warning: don't use this in XEmacs, it seems to crash it!" + (interactive) (let ((sourcefile (concat (file-name-sans-extension (locate-library "slime")) - ".el"))) + ".el")) + (byte-compile-warning-types (remove 'cl-functions + byte-compile-warning-types))) (byte-compile-file sourcefile t))) (defun slime-urge-bytecode-recompile () @@ -2066,7 +2069,8 @@ (defun slime-reset () "Clear all pending continuations." (interactive) - (setf (slime-rex-continuations) '())) + (setf (slime-rex-continuations) '()) + (mapc #'kill-buffer (mapcar #'cdr (sldb-remove-killed-buffers)))) (defconst +slime-sigint+ 2) @@ -3697,34 +3701,34 @@ (re-search-forward (format "[( \t]%s\\>\\(\\s \\|$\\)" name) nil t))) (goto-char (match-beginning 0))) - ;; Looks for a sequence of words (def method name qualifers specializers - ;; don't look for "T" since it isn't requires (arg without t) as class is taken as such. - ((:method name specializers . qualifiers) - (let ((case-fold-search t) - (name (regexp-quote name))) - (or - (and - (re-search-forward - (setq it (format "\\s *(def\\(\\s_\\|\\sw\\)*\\s +%s\\>%s%s" name - (apply 'concat (mapcan (lambda(el) (list ".+?\\<" el "\\>")) qualifiers)) - (apply 'concat (mapcan (lambda(el) (list ".+?\\<" el "\\>")) (remove "T" specializers))) - )) nil t) - (goto-char (match-beginning 0))) -; (slime-goto-location-position `(:function-name ,name)) - - ))) + ;; Looks for a sequence of words (def method name + ;; qualifers specializers don't look for "T" since it isn't + ;; requires (arg without t) as class is taken as such. + ((:method name specializers &rest qualifiers) + (let* ((case-fold-search t) + (name (regexp-quote name)) + (qualifiers (mapconcat (lambda (el) (concat ".+?\\<" el "\\>")) + qualifiers "")) + (specializers (mapconcat (lambda (el) (concat ".+?\\<" el "\\>")) + (remove "T" specializers) "")) + (regexp (format "\\s *(def\\(\\s_\\|\\sw\\)*\\s +%s\\>%s%s" name + qualifiers specializers))) + (or (and (re-search-forward regexp nil t) + (goto-char (match-beginning 0))) + ;; (slime-goto-location-position `(:function-name ,name)) + ))) ((:source-path source-path start-position) (cond (start-position (goto-char start-position) (slime-forward-positioned-source-path source-path)) (t (slime-forward-source-path source-path)))) - ;; Goes to "start" then looks for the anchor text, then moves delta from that position. + ;; Goes to "start" then looks for the anchor text, then moves + ;; delta from that position. ((:text-anchored start text delta) (goto-char start) (slime-isearch text) - (forward-char delta)) - )) + (forward-char delta)))) (defun slime-goto-source-location (location &optional noerror) "Move to the source location LOCATION. Several kinds of locations @@ -4833,7 +4837,7 @@ (defun slime-display-eval-result (value) (slime-message "%s" value)) -(defun slime-eval-with-transcript (form &optional fn) +(defun slime-eval-with-transcript (form &optional fn wait) "Send FROM and PACKAGE to Lisp and pass the result to FN. Display the result in the message area, if FN is nil. Show the output buffer if the evaluation causes any output." @@ -4859,7 +4863,7 @@ (unless (bolp) (insert "\n")) (slime-insert-propertized '(slime-transcript-delimiter t) - ";;;; " (subst-char-in-string ?\n ?\040 + ";;;; " (subst-char-in-string ?\n ?\ (substring string 0 (min 60 (length string)))) " ...\n")))) @@ -4982,7 +4986,7 @@ (defun slime-undefine-function (symbol-name) "Unbind the function slot of SYMBOL-NAME." - (interactive (list (slime-read-symbol-name "fmakunbound: "))) + (interactive (list (slime-read-symbol-name "fmakunbound: " t))) (slime-eval-async `(swank:undefine-function ,symbol-name) (lambda (result) (message "%s" result)))) @@ -5625,7 +5629,8 @@ ("B" 'sldb-break-with-default-debugger) ("P" 'sldb-print-condition) ("C" 'sldb-inspect-condition) - (":" 'slime-interactive-eval)) + (":" 'slime-interactive-eval) + ("\C-c\C-d" slime-doc-map)) ;; Inherit bindings from slime-mode (dolist (spec slime-keys) @@ -6507,7 +6512,7 @@ (insert (fontify topline title)) (while (eq (char-before) ?\n) (backward-delete-char 1)) - (insert " [" (fontify label "type:") " " (fontify type type) "]\n" + (insert "\n [" (fontify label "type:") " " (fontify type type) "]\n" (fontify label "--------------------") "\n") (save-excursion (loop for part in content From heller at common-lisp.net Thu Sep 23 21:19:52 2004 From: heller at common-lisp.net (Helmut Eller) Date: Thu, 23 Sep 2004 23:19:52 +0200 Subject: [slime-cvs] CVS update: slime/swank-backend.lisp Message-ID: Update of /project/slime/cvsroot/slime In directory common-lisp.net:/tmp/cvs-serv30306 Modified Files: swank-backend.lisp Log Message: (frame-package, label-value-line, label-value-line*): New functions. Date: Thu Sep 23 23:19:52 2004 Author: heller Index: slime/swank-backend.lisp diff -u slime/swank-backend.lisp:1.69 slime/swank-backend.lisp:1.70 --- slime/swank-backend.lisp:1.69 Sun Sep 19 07:52:48 2004 +++ slime/swank-backend.lisp Thu Sep 23 23:19:52 2004 @@ -32,6 +32,8 @@ #:inspect-for-emacs #:raw-inspection #:fancy-inspection + #:label-value-line + #:label-value-line* )) (defpackage :swank-mop @@ -438,6 +440,11 @@ (definterface print-frame (frame stream) "Print frame to stream.") +(definterface frame-package (frame) + "Return the preferred package to use when printing local variables. +NIL can be used if no particular package is known." + nil) + (definterface frame-source-location-for-emacs (frame-number) "Return the source location for FRAME-NUMBER.") @@ -683,6 +690,16 @@ (:newline) (:newline) ,(with-output-to-string (desc) (describe object desc))))) + +;;; Utilities to for inspector methods. +;;; +(defun label-value-line (label value) + "Create a control list which prints \"LABEL: VALUE\" in the inspector." + (list (princ-to-string label) ": " `(:value ,value) '(:newline))) + +(defmacro label-value-line* (&rest label-values) + ` (append ,@(loop for (label value) in label-values + collect `(label-value-line ,label ,value)))) (definterface describe-primitive-type (object) "Return a string describing the primitive type of object." From heller at common-lisp.net Thu Sep 23 21:30:35 2004 From: heller at common-lisp.net (Helmut Eller) Date: Thu, 23 Sep 2004 23:30:35 +0200 Subject: [slime-cvs] CVS update: slime/swank.lisp Message-ID: Update of /project/slime/cvsroot/slime In directory common-lisp.net:/tmp/cvs-serv792 Modified Files: swank.lisp Log Message: (frame-locals-for-emacs): Bind *print-pretty* to *sldb-pprint-frames* to get more compact lines and bind *package* to frame-package to get shorter labels for variables. (format-values-for-echo-area): Include the hex and octal representation for integers. (apply-macro-expander, disassemble-symbol): Use the buffer-package for reading. (inspector-content-for-emacs): Use print-part-to-string so that we see cycles in the data structure. (inspect-for-emacs): Minor beatifications. Date: Thu Sep 23 23:30:34 2004 Author: heller Index: slime/swank.lisp diff -u slime/swank.lisp:1.241 slime/swank.lisp:1.242 --- slime/swank.lisp:1.241 Sun Sep 19 09:57:54 2004 +++ slime/swank.lisp Thu Sep 23 23:30:30 2004 @@ -257,7 +257,7 @@ ,@(if (eq (caar (last patterns)) t) '() `((t (error "destructure-case failed: ~S" ,tmp)))))))) - + (defmacro with-temp-package (var &body body) "Execute BODY with VAR bound to a temporary package. The package is deleted before returning." @@ -395,7 +395,8 @@ "Read and process one request. The processing is done in the extend of the toplevel restart." (assert (null *swank-state-stack*)) - (let ((*swank-state-stack* '(:handle-request))) + (let ((*swank-state-stack* '(:handle-request)) + (*debugger-hook* nil)) (with-connection (connection) (with-simple-restart (abort "Abort handling SLIME request.") (read-from-emacs))))) @@ -1136,8 +1137,11 @@ (defun format-values-for-echo-area (values) (with-buffer-syntax () (let ((*print-readably* nil)) - (cond (values (format nil "~{~S~^, ~}" values)) - (t "; No value"))))) + (cond ((null values) "; No value") + ((and (null (cdr values)) (integerp (car values))) + (let ((i (car values))) + (format nil "~D (#x~X, #o~O, #b~B)" i i i i))) + (t (format nil "~{~S~^, ~}" values)))))) (defslimefun interactive-eval (string) (with-buffer-syntax () @@ -1469,12 +1473,13 @@ (defslimefun frame-locals-for-emacs (index) "Return a property list ((&key NAME ID VALUE) ...) describing the local variables in the frame INDEX." - (let ((*print-readably* nil) - (*print-pretty* t) - (*print-circle* t)) + (let* ((*print-readably* nil) + (*print-pretty* *sldb-pprint-frames*) + (*print-circle* t) + (*package* (or (frame-package index) *package*))) (mapcar (lambda (frame-locals) (destructuring-bind (&key name id value) frame-locals - (list :name (to-string name) :id id + (list :name (prin1-to-string name) :id id :value (to-string value)))) (frame-locals index)))) @@ -1608,7 +1613,8 @@ (defun apply-macro-expander (expander string) (declare (type function expander)) - (swank-pprint (list (funcall expander (from-string string))))) + (with-buffer-syntax () + (swank-pprint (list (funcall expander (from-string string)))))) (defslimefun swank-macroexpand-1 (string) (apply-macro-expander #'macroexpand-1 string)) @@ -1620,9 +1626,10 @@ (apply-macro-expander #'macroexpand-all string)) (defslimefun disassemble-symbol (name) - (with-output-to-string (*standard-output*) - (let ((*print-readably* nil)) - (disassemble (fdefinition (from-string name)))))) + (with-buffer-syntax () + (with-output-to-string (*standard-output*) + (let ((*print-readably* nil)) + (disassemble (fdefinition (from-string name))))))) ;;;; Basic completion @@ -2888,23 +2895,17 @@ (values (if (wild-pathname-p pathname) "A wild pathname." "A pathname.") - `("Namestring: " (:value ,(namestring pathname)) - (:newline) - "Host: " (:value ,(pathname-host pathname)) - (:newline) - "Device: " (:value ,(pathname-device pathname)) - (:newline) - "Directory: " (:value ,(pathname-directory pathname)) - (:newline) - "Name: " (:value ,(pathname-name pathname)) - (:newline) - "Type: " (:value ,(pathname-type pathname)) - (:newline) - "Version: " (:value ,(pathname-version pathname)) - ,@(unless (or (wild-pathname-p pathname) - (not (probe-file pathname))) - `((:newline) - "Truename: " (:value ,(truename pathname))))))) + (append (label-value-line* + ("Namestring" (namestring pathname)) + ("Host" (pathname-host pathname)) + ("Device" (pathname-device pathname)) + ("Directory" (pathname-directory pathname)) + ("Name" (pathname-name pathname)) + ("Type" (pathname-type pathname)) + ("Version" (pathname-version pathname))) + (unless (or (wild-pathname-p pathname) + (not (probe-file pathname))) + (label-value-line "Truename" (truename pathname)))))) (defmethod inspect-for-emacs ((pathname logical-pathname) (inspector t)) (declare (ignore inspector)) @@ -2935,50 +2936,44 @@ (defmethod inspect-for-emacs ((i integer) (inspector t)) (declare (ignore inspector)) (values "A number." - `("Value: " ,(princ-to-string i) - " == #x" ,(format nil "~X" i) - " == #o" ,(format nil "~O" i) - " == #b" ,(format nil "~B" i) - " == " ,(format nil "~E" i) - (:newline) - ,@(when (< -1 i char-code-limit) - `("Corresponding character: " (:value ,(code-char i)) (:newline))) - "Length: " (:value ,(integer-length i)) - (:newline) - "As time: " , (multiple-value-bind (sec min hour date month year daylight-p zone) - (decode-universal-time i) - (declare (ignore daylight-p zone)) - (format nil "~4,'0D-~2,'0D-~2,'0DT~2,'0D:~2,'0D:~2,'0DZ" - year month date hour min sec))))) + (append + `(,(format nil "Value: ~D = #x~X = #o~O = ~E" i i i i) (:newline)) + (if (< -1 i char-code-limit) + (label-value-line "Corresponding character" (code-char i))) + (label-value-line "Length" (integer-length i)) + (list "As time" + (multiple-value-bind (sec min hour date month year) + (decode-universal-time i) + (format nil "~4,'0D-~2,'0D-~2,'0DT~2,'0D:~2,'0D:~2,'0DZ" + year month date hour min sec)))))) (defmethod inspect-for-emacs ((c complex) (inspector t)) (declare (ignore inspector)) (values "A complex number." - `("Real part: " (:value ,(realpart c)) - (:newline) - "Imaginary part: " (:value ,(imagpart c))))) + (label-value-line* + ("Real part" (realpart c)) + ("Imaginary part" (imagpart c))))) (defmethod inspect-for-emacs ((r ratio) (inspector t)) (declare (ignore inspector)) (values "A non-integer ratio." - `("Numerator: " (:value ,(numerator r)) - (:newline) - "Denominator: " (:value ,(denominator r)) - (:newline) - "As float: " (:value ,(float r))))) + (label-value-line* + ("Numerator" (numerator r) + ("Denominator" (denominator r)) + ("As float" (float r)))))) (defmethod inspect-for-emacs ((f float) (inspector t)) (declare (ignore inspector)) - (multiple-value-bind (significand exponent sign) - (decode-float f) + (multiple-value-bind (significand exponent sign) (decode-float f) (values "A floating point number." - `("Scientific: " ,(format nil "~E" f) - (:newline) - "Decoded: " (:value ,sign) " * " (:value ,significand) " * " (:value ,(float-radix f)) "^" (:value ,exponent) - (:newline) - "Digits: " (:value ,(float-digits f)) - (:newline) - "Precision: " (:value ,(float-precision f)))))) + (append + `("Scientific: " ,(format nil "~E" f) (:newline) + "Decoded: " + (:value ,sign) " * " + (:value ,significand) " * " + (:value ,(float-radix f)) "^" (:value ,exponent) (:newline)) + (label-value-line "Digits" (float-digits f)) + (label-value-line "Precision" (float-precision f)))))) ;;;; Inspecting @@ -3011,36 +3006,30 @@ string))) (defun inspector-content-for-emacs (spec) - (let ((parse-for-emacs '())) - (labels ((collect-part (part) - (push part parse-for-emacs)) - (parse-part (part) - (if (stringp part) - (push part parse-for-emacs) - (ecase (car part) - (:newline (collect-part (string #\Newline))) - (:value (destructuring-bind (object &optional format) - (cdr part) - (unless (position object *inspectee-parts*) - (vector-push-extend object *inspectee-parts*)) - (unless format - (setf format (block print-object - (handler-bind - ((error (lambda (c) - (declare (ignore c)) - (return-from print-object "#")))) - (format nil "~S" object))))) - (collect-part `(:value ,format - ,(position object *inspectee-parts*))))) - (:action (destructuring-bind (label lambda) - (cdr part) - (unless (position lambda *inspectee-actions*) - (vector-push-extend lambda *inspectee-actions*)) - (collect-part `(:action ,label ,(position lambda *inspectee-actions*))))) - ((nil) nil))))) - (map 'nil #'parse-part spec)) - (nreverse parse-for-emacs))) + (loop for part in spec collect + (etypecase part + (string part) + (cons (destructure-case part + ((:newline) + (string #\newline)) + ((:value obj &optional str) + (value-part-for-emacs obj str)) + ((:action label lambda) + (action-part-for-emacs label lambda))))))) + +(defun assign-index (object vector) + (or (position object vector) + (progn (vector-push-extend object vector) + (position object vector)))) + +(defun value-part-for-emacs (object string) + (list :value + (or string (print-part-to-string object)) + (assign-index object *inspectee-parts*))) +(defun action-part-for-emacs (label lambda) + (list :action label (assign-index lambda *inspectee-actions*))) + (defun inspect-object (object &optional (inspector (make-default-inspector))) (push (setq *inspectee* object) *inspector-stack*) (unless (find object *inspector-history*) From heller at common-lisp.net Thu Sep 23 21:33:52 2004 From: heller at common-lisp.net (Helmut Eller) Date: Thu, 23 Sep 2004 23:33:52 +0200 Subject: [slime-cvs] CVS update: slime/swank-cmucl.lisp Message-ID: Update of /project/slime/cvsroot/slime In directory common-lisp.net:/tmp/cvs-serv1332 Modified Files: swank-cmucl.lisp Log Message: (frame-package): Implemented. (inspect-for-emacs): Only include stuff that is actually in those stored in the object itself (see objdef.lisp for exact object layout). Include disassembly for functions and code components. Date: Thu Sep 23 23:33:51 2004 Author: heller Index: slime/swank-cmucl.lisp diff -u slime/swank-cmucl.lisp:1.120 slime/swank-cmucl.lisp:1.121 --- slime/swank-cmucl.lisp:1.120 Sun Sep 19 08:17:19 2004 +++ slime/swank-cmucl.lisp Thu Sep 23 23:33:51 2004 @@ -1507,6 +1507,15 @@ (error (e) (ignore-errors (princ e stream)))))) +(defimplementation frame-package (frame-number) + (find-package + (ignore-errors + (c::compiled-debug-info-package + (kernel:%code-debug-info + (kernel:function-code-header + (di:debug-function-function + (di:frame-debug-function (nth-frame frame-number))))))))) + (defimplementation frame-source-location-for-emacs (index) (code-location-source-location (di:frame-code-location (nth-frame index)))) @@ -1826,82 +1835,70 @@ (defimplementation inspect-for-emacs ((o t) (inspector cmucl-inspector)) (cond ((di::indirect-value-cell-p o) - (values "A value cell." + (values (format nil "~A is a value cell." o) `("Value: " (:value ,(c:value-cell-ref o))))) (t (destructuring-bind (text labeledp . parts) - (inspect::describe-parts o) - (values "A value." + (inspect::describe-parts o) + (values (format nil "~A~%" text) (if labeledp (loop for (label . value) in parts - collect (princ-to-string label) - collect " = " - collect `(:value ,value) - collect '(:newline)) - (loop for value in parts - collect `(:value ,value) - collect '(:newline)))))))) + append (label-value-line label value)) + (loop for value in parts for i from 0 + append (label-value-line i value)))))))) (defmethod inspect-for-emacs ((o function) (inspector cmucl-inspector)) (declare (ignore inspector)) (let ((header (kernel:get-type o))) (cond ((= header vm:function-header-type) - (values "A function." - `("Name: " (:value ,(kernel:%function-name o)) - (:newline) - "Arglist: " (:value ,(kernel:%function-arglist o)) - (:newline) - ,@(when (documentation o t) - `("Documentation: " (:newline) ,(documentation o t))) - (:newline) - "Self: " (:value ,(kernel:%function-self o)) - (:newline) - "Next: " (:value ,(kernel:%function-next o)) - (:newline) - "Type: " (:value ,(kernel:%function-type o)) - (:newline) - "Code Object: " (:value ,(kernel:function-code-header o))))) + (values (format nil "~A is a function." o) + (append (label-value-line* + ("self" (kernel:%function-self o)) + ("next" (kernel:%function-next o)) + ("name" (kernel:%function-name o)) + ("arglist" (kernel:%function-arglist o)) + ("type" (kernel:%function-type o)) + ("code" (kernel:function-code-header o))) + (list + (with-output-to-string (s) + (disassem:disassemble-function o :stream s)))))) ((= header vm:closure-header-type) - (values "A closure." - (list* - `("Function: " (:value ,(kernel:%closure-function o)) - (:newline) - ,@(when (documentation o t) - `("Documentation: " (:newline) ,(documentation o t) (:newline))) - ,@(loop - for i from 0 below (- (kernel:get-closure-length o) - (1- vm:closure-info-offset)) - collect (princ-to-string i) - collect " = " - collect `(:value ,(kernel:%closure-index-ref o i))))))) + (values (format nil "~A is a closure" o) + (append + (label-value-line "function" (kernel:%closure-function o)) + `("Environment:" (:newline)) + (loop for i from 0 below (1- (kernel:get-closure-length o)) + append (label-value-line + i (kernel:%closure-index-ref o i)))))) (t (call-next-method o))))) -(defmethod inspect-for-emacs ((o kernel:code-component) (inspector cmucl-inspector)) - (declare (ignore inspector)) - (values "A code data-block." - `("First entry point: " (:value ,(kernel:%code-entry-points o)) - (:newline) - "Constants:" (:newline) - ,@(loop for i from vm:code-constants-offset - below (kernel:get-header-data o) - collect (princ-to-string i) - collect " = " - collect `(:value ,(kernel:code-header-ref o i)) - collect '(:newline)) - "Debug info: " (:value ,(kernel:%code-debug-info o)) - (:newline) - "Instructions: " (:value ,(kernel:code-instructions o)) - (:newline) - ,@(when (documentation o t) - `("Documentation: " (:newline) ,(documentation o t))) - (:newline)))) +(defmethod inspect-for-emacs ((o kernel:code-component) (_ cmucl-inspector)) + (declare (ignore _)) + (values (format nil "~A is a code data-block." o) + (append + (label-value-line* + ("code-size" (kernel:%code-code-size o)) + ("entry-points" (kernel:%code-entry-points o)) + ("debug-info" (kernel:%code-debug-info o)) + ("trace-table-offset" (kernel:code-header-ref + o vm:code-trace-table-offset-slot))) + `("Constants:" (:newline)) + (loop for i from vm:code-constants-offset + below (kernel:get-header-data o) + append (label-value-line i (kernel:code-header-ref o i))) + `("Code:" (:newline) + , (with-output-to-string (s) + (disassem:disassemble-code-component o :stream s)))))) (defmethod inspect-for-emacs ((o kernel:fdefn) (inspector cmucl-inspector)) (declare (ignore inspector)) - (values "A fdefn object." - `("Name: " (:value ,(kernel:fdefn-name o)) - (:newline) - "Function: " (:value ,(kernel:fdefn-function o))))) + (values (format nil "~A is a fdenf object." o) + (label-value-line* + ("name" (kernel:fdefn-name o)) + ("function" (kernel:fdefn-function o)) + ("raw-addr" (sys:sap-ref-32 + (sys:int-sap (kernel:get-lisp-obj-address o)) + (* vm:fdefn-raw-addr-slot vm:word-bytes)))))) ;;;; Profiling From heller at common-lisp.net Thu Sep 23 21:39:47 2004 From: heller at common-lisp.net (Helmut Eller) Date: Thu, 23 Sep 2004 23:39:47 +0200 Subject: [slime-cvs] CVS update: slime/ChangeLog Message-ID: Update of /project/slime/cvsroot/slime In directory common-lisp.net:/tmp/cvs-serv3687 Modified Files: ChangeLog Log Message: *** empty log message *** Date: Thu Sep 23 23:39:47 2004 Author: heller Index: slime/ChangeLog diff -u slime/ChangeLog:1.538 slime/ChangeLog:1.539 --- slime/ChangeLog:1.538 Sun Sep 19 10:04:57 2004 +++ slime/ChangeLog Thu Sep 23 23:39:47 2004 @@ -1,3 +1,34 @@ +2004-09-23 Helmut Eller + + * slime.el (slime-start-and-load): Take arguments so that the + function can be called non-interactively. + (slime-recompile-bytecode): Don't warn about uses of cl-functions. + (slime-reset): Kill all sldb buffers. + (slime-goto-location-position): Fix syntax for Emacs 20. + (sldb-mode-map): Add C-c C-d bindings. + (slime-open-inspector): Insert the type in the second line so that + we can make longer titles, e.g we should include the princed + version of the inspected object. + + * swank-backend.lisp (frame-package, label-value-line) + (label-value-line*): New functions. + + * swank.lisp (frame-locals-for-emacs): Bind *print-pretty* to + *sldb-pprint-frames* to get more compact lines and bind *package* + to frame-package to get shorter labels for variables. + (format-values-for-echo-area): Include the hex and octal + representation for integers. + (apply-macro-expander, disassemble-symbol): Use the buffer-package + for reading. + (inspector-content-for-emacs): Use print-part-to-string so that we + see cycles in the data structure. + (inspect-for-emacs): Minor beautifications. + + * swank-cmucl.lisp (frame-package): Implemented. + (inspect-for-emacs): Only include stuff that is actually stored in + the object itself (see objdef.lisp for exact object layout). + Include the disassembly for functions and code components. + 2004-09-19 Helmut Eller * swank-gray.lisp (stream-read-char): Treat empty strings as From heller at common-lisp.net Thu Sep 23 22:22:18 2004 From: heller at common-lisp.net (Helmut Eller) Date: Fri, 24 Sep 2004 00:22:18 +0200 Subject: [slime-cvs] CVS update: slime/slime.el Message-ID: Update of /project/slime/cvsroot/slime In directory common-lisp.net:/tmp/cvs-serv12342 Modified Files: slime.el Log Message: (slime-start-and-load): Only start SLIME is if it is not running. Date: Fri Sep 24 00:22:17 2004 Author: heller Index: slime/slime.el diff -u slime/slime.el:1.402 slime/slime.el:1.403 --- slime/slime.el:1.402 Thu Sep 23 23:18:04 2004 +++ slime/slime.el Fri Sep 24 00:22:17 2004 @@ -1184,20 +1184,25 @@ (message "Connected. %s" (slime-random-words-of-encouragement)))) (defun slime-start-and-load (filename &optional package) - "Start Slime, load the current file and set the package." + "Start Slime, if needed, load the current file and set the package." (interactive (list (expand-file-name (buffer-file-name)) (slime-find-buffer-package))) - (lexical-let ((hook nil) (package package) - (filename (slime-to-lisp-filename filename))) - (setq hook (lambda () - (remove-hook 'slime-connected-hook hook) - (slime-eval-async - `(swank:load-file ,filename) - (lambda (result) - (when package - (slime-repl-set-package package)))))) - (add-hook 'slime-connected-hook hook) - (slime))) + (cond ((slime-connected-p) + (slime-load-file-set-package filename package)) + (t + (lexical-let ((hook nil) (package package) (filename filename)) + (setq hook (lambda () + (remove-hook 'slime-connected-hook hook) + (slime-load-file-set-package filename package))) + (add-hook 'slime-connected-hook hook) + (slime))))) + +(defun slime-load-file-set-package (filename package) + (let ((filename (slime-to-lisp-filename filename))) + (slime-eval-async `(swank:load-file-set-package ,filename ,package) + (lambda (package) + (when package + (slime-repl-set-package (second package))))))) ;;;;; Start inferior lisp ;;; From heller at common-lisp.net Thu Sep 23 22:23:07 2004 From: heller at common-lisp.net (Helmut Eller) Date: Fri, 24 Sep 2004 00:23:07 +0200 Subject: [slime-cvs] CVS update: slime/swank.lisp Message-ID: Update of /project/slime/cvsroot/slime In directory common-lisp.net:/tmp/cvs-serv12430 Modified Files: swank.lisp Log Message: (load-file-set-package): New function. Date: Fri Sep 24 00:23:07 2004 Author: heller Index: slime/swank.lisp diff -u slime/swank.lisp:1.242 slime/swank.lisp:1.243 --- slime/swank.lisp:1.242 Thu Sep 23 23:30:30 2004 +++ slime/swank.lisp Fri Sep 24 00:23:07 2004 @@ -1248,7 +1248,8 @@ (swank-pprint (multiple-value-list (eval (read-from-string string)))))) (defslimefun set-package (package) - "Set *package* to PACKAGE and return its name and the string to use in the prompt." + "Set *package* to PACKAGE. +Return its name and the string to use in the prompt." (let ((p (setq *package* (guess-package-from-string package)))) (list (package-name p) (package-string-for-prompt p)))) @@ -1607,6 +1608,11 @@ (defslimefun load-file (filename) (to-string (load filename))) + +(defslimefun load-file-set-package (filename &optional package) + (load-file filename) + (if package + (set-package package))) ;;;; Macroexpansion From heller at common-lisp.net Thu Sep 23 22:24:18 2004 From: heller at common-lisp.net (Helmut Eller) Date: Fri, 24 Sep 2004 00:24:18 +0200 Subject: [slime-cvs] CVS update: slime/ChangeLog Message-ID: Update of /project/slime/cvsroot/slime In directory common-lisp.net:/tmp/cvs-serv12537 Modified Files: ChangeLog Log Message: *** empty log message *** Date: Fri Sep 24 00:24:17 2004 Author: heller Index: slime/ChangeLog diff -u slime/ChangeLog:1.539 slime/ChangeLog:1.540 --- slime/ChangeLog:1.539 Thu Sep 23 23:39:47 2004 +++ slime/ChangeLog Fri Sep 24 00:24:17 2004 @@ -1,7 +1,8 @@ 2004-09-23 Helmut Eller * slime.el (slime-start-and-load): Take arguments so that the - function can be called non-interactively. + function can be called non-interactively. Only start SLIME is if + it is not running. (slime-recompile-bytecode): Don't warn about uses of cl-functions. (slime-reset): Kill all sldb buffers. (slime-goto-location-position): Fix syntax for Emacs 20. @@ -23,6 +24,7 @@ (inspector-content-for-emacs): Use print-part-to-string so that we see cycles in the data structure. (inspect-for-emacs): Minor beautifications. + (load-file-set-package): New function. * swank-cmucl.lisp (frame-package): Implemented. (inspect-for-emacs): Only include stuff that is actually stored in From lgorrie at common-lisp.net Thu Sep 23 23:17:43 2004 From: lgorrie at common-lisp.net (Luke Gorrie) Date: Fri, 24 Sep 2004 01:17:43 +0200 Subject: [slime-cvs] CVS update: slime/doc/slime.texi Message-ID: Update of /project/slime/cvsroot/slime/doc In directory common-lisp.net:/tmp/cvs-serv27146 Modified Files: slime.texi Log Message: Removed some CVS conflict markers. Date: Fri Sep 24 01:17:43 2004 Author: lgorrie Index: slime/doc/slime.texi diff -u slime/doc/slime.texi:1.30 slime/doc/slime.texi:1.31 --- slime/doc/slime.texi:1.30 Fri Sep 17 15:01:01 2004 +++ slime/doc/slime.texi Fri Sep 24 01:17:43 2004 @@ -45,13 +45,8 @@ @code{\command\}@* @end macro -<<<<<<< slime.texi @set EDITION 1.0 - at set UPDATED @code{$Date: 2004/09/17 13:01:01 $} -======= - at set EDITION 1.0 - at set UPDATED @code{$Date: 2004/09/17 13:01:01 $} ->>>>>>> 1.28 + at set UPDATED @code{$Date: 2004/09/23 23:17:43 $} @titlepage @title SLIME User Manual From asimon at common-lisp.net Sun Sep 26 17:07:46 2004 From: asimon at common-lisp.net (Andras Simon) Date: Sun, 26 Sep 2004 19:07:46 +0200 Subject: [slime-cvs] CVS update: slime/swank-abcl.lisp Message-ID: Update of /project/slime/cvsroot/slime In directory common-lisp.net:/tmp/cvs-serv13898 Modified Files: swank-abcl.lisp Log Message: Remove dependence on Gray streams, use abcl's slime streams. Date: Sun Sep 26 19:07:46 2004 Author: asimon Index: slime/swank-abcl.lisp diff -u slime/swank-abcl.lisp:1.18 slime/swank-abcl.lisp:1.19 --- slime/swank-abcl.lisp:1.18 Tue Sep 21 01:42:36 2004 +++ slime/swank-abcl.lisp Sun Sep 26 19:07:46 2004 @@ -13,30 +13,12 @@ (eval-when (:compile-toplevel :load-toplevel :execute) (require :collect) ;just so that it doesn't spoil the flying letters - (require :gray-streams) (require :pprint)) -(defun xp::decode-stream-arg (stream) - (cond ((eq stream t) - *terminal-io*) - ((null stream) - *standard-output*) - ((gs::two-way-stream-g-p stream) - (gs::two-way-stream-output-stream stream)) - (t stream))) - -(import - '(gs:fundamental-character-output-stream - gs:stream-write-char - gs:stream-force-output - gs:fundamental-character-input-stream - gs:stream-read-char - gs:stream-listen - gs:stream-unread-char - gs:stream-clear-input - gs:stream-line-column - gs:stream-read-char-no-hang - )) +(defimplementation make-fn-streams (input-fn output-fn) + (let* ((output (ext:make-slime-output-stream output-fn)) + (input (ext:make-slime-input-stream input-fn output))) + (values input output))) ;;; swank-mop From asimon at common-lisp.net Sun Sep 26 17:09:13 2004 From: asimon at common-lisp.net (Andras Simon) Date: Sun, 26 Sep 2004 19:09:13 +0200 Subject: [slime-cvs] CVS update: slime/swank-loader.lisp Message-ID: Update of /project/slime/cvsroot/slime In directory common-lisp.net:/tmp/cvs-serv13928 Modified Files: swank-loader.lisp Log Message: Don't load swank-gray for abcl. Date: Sun Sep 26 19:09:13 2004 Author: asimon Index: slime/swank-loader.lisp diff -u slime/swank-loader.lisp:1.34 slime/swank-loader.lisp:1.35 --- slime/swank-loader.lisp:1.34 Mon Sep 13 07:37:03 2004 +++ slime/swank-loader.lisp Sun Sep 26 19:09:13 2004 @@ -30,7 +30,7 @@ #+lispworks '("swank-lispworks" "swank-gray") #+allegro '("swank-allegro" "swank-gray") #+clisp '("xref" "metering" "swank-clisp" "swank-gray") - #+armedbear '("swank-abcl" "swank-gray") + #+armedbear '("swank-abcl") ))) (defparameter *lisp-name* From heller at common-lisp.net Mon Sep 27 22:21:51 2004 From: heller at common-lisp.net (Helmut Eller) Date: Tue, 28 Sep 2004 00:21:51 +0200 Subject: [slime-cvs] CVS update: slime/slime.el Message-ID: Update of /project/slime/cvsroot/slime In directory common-lisp.net:/tmp/cvs-serv3216 Modified Files: slime.el Log Message: (define-slime-dialect): New macro to make invoking different command lines easier. (slime-process): New function intended to replace all those references to the *inferior-lisp* buffer. (slime-maybe-start-lisp): Split it up. (slime-start-lisp): New function. (slime-restart-inferior-lisp): Use the command from the existing process to start the new process. (slime-browse-classes, slime-browse-xrefs): New commands to browse class hierarchies and xref graphs in a tree widget. By Rui Patroc?nio. Date: Tue Sep 28 00:21:50 2004 Author: heller Index: slime/slime.el diff -u slime/slime.el:1.403 slime/slime.el:1.404 --- slime/slime.el:1.403 Fri Sep 24 00:22:17 2004 +++ slime/slime.el Tue Sep 28 00:21:50 2004 @@ -62,6 +62,7 @@ (when (featurep 'xemacs) (require 'overlay)) (require 'easymenu) +(require 'tree-widget) (defvar slime-use-autodoc-mode nil "When non-nil always enabled slime-autodoc-mode in slime-mode.") @@ -1160,7 +1161,7 @@ (slime-urge-bytecode-recompile)) (cond ((and current-prefix-arg (slime-connected-p) - (get-buffer "*inferior-lisp*")) + (slime-process)) (unless (slime-maybe-rearrange-inferior-lisp) (slime-disconnect))) (t (slime-disconnect))) @@ -1204,6 +1205,23 @@ (when package (slime-repl-set-package (second package))))))) +(defmacro define-slime-dialect (name &optional program hook) + "Define a command slime-dialect-NAME to start a specific Lisp. +PROGRAM is the command to start the inferior process. +HOOK is function which is run before the process is started." + (let ((funsym (intern (format "slime-dialect-%s" name))) + (hooksym (intern (format "slime-dialect-%s-hook" name))) + (progsym (intern (format "slime-dialect-%s-program" name)))) + `(progn + (defvar ,progsym ,program) + (defvar ,hooksym ,hook) + (defun ,funsym () + ,(format "Start up slime according to `%s'." progsym) + (interactive) + (let ((inferior-lisp-program ,progsym)) + (run-hook ',hooksym) + (call-interactively 'slime)))))) + ;;;;; Start inferior lisp ;;; ;;; Here is the protocol for starting SLIME: @@ -1268,23 +1286,26 @@ (defun slime-maybe-rearrange-inferior-lisp () "Offer to rename *inferior-lisp* so that another can be started." (when (y-or-n-p "Create an additional *inferior-lisp*? ") - (with-current-buffer "*inferior-lisp*" + (with-current-buffer (process-buffer (slime-process)) (rename-buffer (generate-new-buffer-name (buffer-name))) t))) (defun slime-maybe-start-lisp () "Start an inferior lisp. Instruct it to load Swank." - (unless (get-buffer-process (get-buffer "*inferior-lisp*")) - (call-interactively 'inferior-lisp) - (when slime-kill-without-query-p - (process-kill-without-query (inferior-lisp-proc))) - (comint-send-string (inferior-lisp-proc) - (format "(load %S)\n" - (slime-to-lisp-filename - (if (file-name-absolute-p slime-backend) - slime-backend - (concat slime-path slime-backend))))) - (slime-maybe-start-multiprocessing))) + (unless (get-buffer-process inferior-lisp-buffer) + (slime-start-lisp))) + +(defun slime-start-lisp () + (call-interactively 'inferior-lisp) + (when slime-kill-without-query-p + (process-kill-without-query (inferior-lisp-proc))) + (comint-send-string (inferior-lisp-proc) + (format "(load %S)\n" + (slime-to-lisp-filename + (if (file-name-absolute-p slime-backend) + slime-backend + (concat slime-path slime-backend))))) + (slime-maybe-start-multiprocessing)) (defun slime-maybe-start-multiprocessing () (when slime-multiprocessing @@ -1353,7 +1374,7 @@ (defun slime-hide-inferior-lisp-buffer () "Display the REPL buffer instead of the *inferior-lisp* buffer." - (let* ((buffer (get-buffer "*inferior-lisp*")) + (let* ((buffer (if (slime-process) (process-buffer (slime-process)))) (window (if buffer (get-buffer-window buffer))) (repl (slime-output-buffer t))) (when buffer @@ -1801,6 +1822,15 @@ (car (process-id connection)) (cadr (process-contact connection)))) +(defun slime-process (&optional connection) + "Return the Lisp process for CONNECTION (default `slime-connection'). +Can return nil if there's no process object for the connection." + (let* ((pid (slime-pid connection)) + (proc (find pid (process-list) :key #'process-id))) + (case (and proc (process-status proc)) + ((run stop) proc) + ((exit nil signal) nil)))) + ;;;; Communication protocol @@ -3024,8 +3054,16 @@ (defslime-repl-shortcut slime-restart-inferior-lisp ("restart-inferior-lisp") (:handler (lambda () (interactive) - (ignore-errors (kill-buffer "*inferior-lisp*")) - (slime))) + (let* ((proc (slime-process)) + (inferior-lisp-program ; for the new process + (if proc + (mapconcat #'identity (process-command proc) " ") + inferior-lisp-program))) + (ignore-errors (kill-process proc)) + (while (comint-check-proc (process-buffer proc)) + (sit-for 0 20)) + (slime-start-lisp) + (slime-inferior-connect)))) (:one-liner "Restart *inferior-lisp* and reconnect SLIME.")) @@ -6610,6 +6648,69 @@ ("q" 'slime-inspector-quit) ("\C-i" 'slime-inspector-next-inspectable-object) ("\M-." 'slime-edit-definition)) + + +;;;; classes browser + +(defun slime-expand-class-node (node) + (or (widget-get widget :args) + (let ((name (widget-get node :tag))) + (loop for kid in (slime-eval `(swank:mop :subclasses ,name)) + collect `(tree-widget :tag ,kid + :dynargs slime-expand-class-node + :has-children t))))) + +(defun slime-browse-classes (name) + "Read the name of a class and show its subclasses." + (interactive (list (slime-read-symbol-name "Class Name: "))) + (slime-call-with-browser-setup + "*slime class browser*" (slime-current-package) "Class Browser" + (lambda () + (widget-create 'tree-widget :tag name + :dynargs 'slime-expand-class-node + :has-echildren t)))) + +(defun slime-call-with-browser-setup (buffer package title fn) + (switch-to-buffer buffer) + (kill-all-local-variables) + (setq slime-buffer-package package) + (let ((inhibit-read-only t)) (erase-buffer)) + (widget-insert title "\n\n") + (funcall fn) + (lisp-mode) + (slime-mode t) + (use-local-map widget-keymap) + (widget-setup)) + + +;;;; Xref browser + +(defun slime-expand-xrefs (node) + (or (widget-get widget :args) + (let ((name (widget-get node :tag)) + (type (widget-get node :xref-type))) + (let ((specs (loop for (file . specs) in (slime-eval + `(swank:xref ,type ,name)) + append specs))) + + (loop for (dspec . _) in specs + collect `(tree-widget :tag ,dspec + :xref-type ,type + :dynargs slime-expand-xrefs + :has-children t)))))) + +(defun slime-browse-xrefs (name type) + "Show the xref graph of a function in a tree widget." + (interactive (list (read-from-minibuffer "Name: ") + (read (completing-read "Type: " + (slime-bogus-completion-alist + '(":callees" ":callers" ":calls")) + nil t ":")))) + (slime-call-with-browser-setup + "*slime xref browser*" (slime-current-package) "Xref Browser" + (lambda () + (widget-create 'tree-widget :tag name :xref-type type + :dynargs 'slime-expand-xrefs :has-echildren t)))) ;;;; Buffer selector From heller at common-lisp.net Mon Sep 27 22:23:02 2004 From: heller at common-lisp.net (Helmut Eller) Date: Tue, 28 Sep 2004 00:23:02 +0200 Subject: [slime-cvs] CVS update: slime/swank.lisp Message-ID: Update of /project/slime/cvsroot/slime In directory common-lisp.net:/tmp/cvs-serv4868 Modified Files: swank.lisp Log Message: (mop, mop-helper): Support functions for the class browser. By Rui Patroc?nio. Date: Tue Sep 28 00:23:01 2004 Author: heller Index: slime/swank.lisp diff -u slime/swank.lisp:1.243 slime/swank.lisp:1.244 --- slime/swank.lisp:1.243 Fri Sep 24 00:23:07 2004 +++ slime/swank.lisp Tue Sep 28 00:23:01 2004 @@ -2947,7 +2947,7 @@ (if (< -1 i char-code-limit) (label-value-line "Corresponding character" (code-char i))) (label-value-line "Length" (integer-length i)) - (list "As time" + (list "As time: " (multiple-value-bind (sec min hour date month year) (decode-universal-time i) (format nil "~4,'0D-~2,'0D-~2,'0DT~2,'0D:~2,'0D:~2,'0DZ" @@ -2958,15 +2958,15 @@ (values "A complex number." (label-value-line* ("Real part" (realpart c)) - ("Imaginary part" (imagpart c))))) + ("Imaginary part" (imagpart c))))) (defmethod inspect-for-emacs ((r ratio) (inspector t)) (declare (ignore inspector)) (values "A non-integer ratio." (label-value-line* - ("Numerator" (numerator r) + ("Numerator" (numerator r)) ("Denominator" (denominator r)) - ("As float" (float r)))))) + ("As float" (float r))))) (defmethod inspect-for-emacs ((f float) (inspector t)) (declare (ignore inspector)) @@ -2981,9 +2981,6 @@ (label-value-line "Digits" (float-digits f)) (label-value-line "Precision" (float-precision f)))))) - -;;;; Inspecting - (defvar *inspectee*) (defvar *inspectee-parts* (make-array 10 :adjustable t :fill-pointer 0)) (defvar *inspectee-actions* (make-array 10 :adjustable t :fill-pointer 0)) @@ -3138,6 +3135,29 @@ (interrupt-thread (nth-thread index) (lambda () (start-server port-file-name nil)))) + +;;;; Class browser + +(defun mop-helper (class-name fn) + (let ((class (find-class class-name nil))) + (if class + (mapcar (lambda (x) (to-string (class-name x))) + (funcall fn class))))) + +(defslimefun mop (type symbol-name) + "Return info about classes using mop. + + When type is: + :subclasses - return the list of subclasses of class. + :superclasses - return the list of superclasses of class." + (let ((symbol (parse-symbol symbol-name *buffer-package*))) + (ecase type + (:subclasses + (mop-helper symbol #'swank-mop:class-direct-subclasses)) + (:superclasses + (mop-helper symbol #'swank-mop:class-direct-superclasses))))) + + ;;;; Automatically synchronized state From heller at common-lisp.net Mon Sep 27 22:35:11 2004 From: heller at common-lisp.net (Helmut Eller) Date: Tue, 28 Sep 2004 00:35:11 +0200 Subject: [slime-cvs] CVS update: slime/tree-widget.el Message-ID: Update of /project/slime/cvsroot/slime In directory common-lisp.net:/tmp/cvs-serv8131 Added Files: tree-widget.el Log Message: Add it to cvs for Emacs 20. Date: Tue Sep 28 00:35:11 2004 Author: heller From heller at common-lisp.net Mon Sep 27 22:39:42 2004 From: heller at common-lisp.net (Helmut Eller) Date: Tue, 28 Sep 2004 00:39:42 +0200 Subject: [slime-cvs] CVS update: slime/ChangeLog Message-ID: Update of /project/slime/cvsroot/slime In directory common-lisp.net:/tmp/cvs-serv9672 Modified Files: ChangeLog Log Message: *** empty log message *** Date: Tue Sep 28 00:39:41 2004 Author: heller Index: slime/ChangeLog diff -u slime/ChangeLog:1.540 slime/ChangeLog:1.541 --- slime/ChangeLog:1.540 Fri Sep 24 00:24:17 2004 +++ slime/ChangeLog Tue Sep 28 00:39:40 2004 @@ -1,3 +1,28 @@ +2004-09-27 Helmut Eller + + * slime.el (slime-process): New function intended to replace all + those references to the *inferior-lisp* buffer. + (slime-maybe-start-lisp): Split it up. + (slime-start-lisp): New function. + (slime-restart-inferior-lisp): Use the command from the existing + process to start the new process. + +2004-09-27 Christian Lynbech + + * slime.el (define-slime-dialect): New macro to make starting + Lisps with different command line options easier. + +2004-09-27 Rui Patroc?nio + + * swank.lisp (mop, mop-helper): Support functions for the class + browser. + + * slime.el (slime-browse-classes, slime-browse-xrefs): New + commands to browse class hierarchies and xref graphs in a tree + widget. + + * tree-widget.el: New file. Only needed for older Emacsen. + 2004-09-23 Helmut Eller * slime.el (slime-start-and-load): Take arguments so that the