From lgorrie at common-lisp.net Fri Apr 1 08:42:18 2005 From: lgorrie at common-lisp.net (Luke Gorrie) Date: Fri, 1 Apr 2005 10:42:18 +0200 (CEST) Subject: [slime-cvs] CVS update: slime/slime.el Message-ID: <20050401084218.50F0A88669@common-lisp.net> Update of /project/slime/cvsroot/slime In directory common-lisp.net:/tmp/cvs-serv7371 Modified Files: slime.el Log Message: (slime-keys): Bind slime-edit-definition-other-window to `C-x 4 .' and slime-edit-definition-other-frame to `C-x 5 .', shadowing the equivalent find-tag... bindings. (slime-goto-definition): In the other-window and other-frame cases, make sure point does not move in the originating window, even when the definition is found in the same buffer. Date: Fri Apr 1 10:42:16 2005 Author: lgorrie Index: slime/slime.el diff -u slime/slime.el:1.474 slime/slime.el:1.475 --- slime/slime.el:1.474 Thu Mar 31 21:33:40 2005 +++ slime/slime.el Fri Apr 1 10:42:15 2005 @@ -555,6 +555,8 @@ ("\C-i" slime-complete-symbol :prefixed t :inferior t) ("\M-i" slime-fuzzy-complete-symbol :prefixed t :inferior t) ("\M-." slime-edit-definition :inferior t :sldb t) + ("\C-x4." slime-edit-definition-other-window :inferior t :sldb t) + ("\C-x5." slime-edit-definition-other-frame :inferior t :sldb t) ("\M-," slime-pop-find-definition-stack :inferior t :sldb t) ("\M-*" slime-pop-find-definition-stack :inferior t :sldb t) ("\C-q" slime-close-parens-at-point :prefixed t :inferior t) @@ -5127,14 +5129,24 @@ (cond ((slime-length> definitions 1) (slime-show-definitions name definitions)) (t - (slime-goto-source-location (slime-definition.location - (car definitions))) (cond ((equal where 'window) - (switch-to-buffer-other-window (current-buffer))) + (slime-goto-definition-other-window (car definitions))) ((equal where 'frame) - (switch-to-buffer-other-frame (current-buffer))) + (let ((pop-up-frames t)) + (slime-goto-definition-other-window (car definitions)))) (t + (slime-goto-source-location (slime-definition.location + (car definitions))) (switch-to-buffer (current-buffer))))))) + +(defun slime-goto-definition-other-window (definition) + (slime-pop-to-other-window) + (slime-goto-source-location (slime-definition.location definition)) + (switch-to-buffer (current-buffer))) + +(defun slime-pop-to-other-window () + "Pop to the other window, but not to any particular buffer." + (pop-to-buffer (current-buffer) t)) (defun slime-edit-definition-other-window (name) "Like `slime-edit-definition' but switch to the other window." From lgorrie at common-lisp.net Fri Apr 1 08:43:19 2005 From: lgorrie at common-lisp.net (Luke Gorrie) Date: Fri, 1 Apr 2005 10:43:19 +0200 (CEST) Subject: [slime-cvs] CVS update: slime/ChangeLog Message-ID: <20050401084319.30B6A88669@common-lisp.net> Update of /project/slime/cvsroot/slime In directory common-lisp.net:/tmp/cvs-serv7397 Modified Files: ChangeLog Log Message: *** empty log message *** Date: Fri Apr 1 10:43:18 2005 Author: lgorrie Index: slime/ChangeLog diff -u slime/ChangeLog:1.651 slime/ChangeLog:1.652 --- slime/ChangeLog:1.651 Sun Mar 27 21:42:54 2005 +++ slime/ChangeLog Fri Apr 1 10:43:18 2005 @@ -1,3 +1,20 @@ +2005-04-01 Matthias Koeppe + + * slime.el (slime-keys): Bind slime-edit-definition-other-window + to `C-x 4 .' and slime-edit-definition-other-frame to `C-x 5 .', + shadowing the equivalent find-tag... bindings. + (slime-goto-definition): In the other-window and other-frame cases, + make sure point does not move in the originating window, even when + the definition is found in the same buffer. + +2005-03-31 Luke Gorrie + + * doc/slime.texi (slime-selector): New section. + (Inspector): Updated for the post-1.0 inspector. + + * slime.el (slime-selector): Removed unneeded "the" prefixes in + descriptions of what the selector methods do. + 2005-03-27 Helmut Eller * PROBLEMS, NEWS, doc/slime.texi: Some updates for the upcoming From lgorrie at common-lisp.net Fri Apr 1 11:02:25 2005 From: lgorrie at common-lisp.net (Luke Gorrie) Date: Fri, 1 Apr 2005 13:02:25 +0200 (CEST) Subject: [slime-cvs] CVS update: slime/slime.el Message-ID: <20050401110225.1AF48884E2@common-lisp.net> Update of /project/slime/cvsroot/slime In directory common-lisp.net:/tmp/cvs-serv16217 Modified Files: slime.el Log Message: (slime-goto-definition): Handle :error locations here before any window/buffer changes are made. Date: Fri Apr 1 13:02:18 2005 Author: lgorrie Index: slime/slime.el diff -u slime/slime.el:1.475 slime/slime.el:1.476 --- slime/slime.el:1.475 Fri Apr 1 10:42:15 2005 +++ slime/slime.el Fri Apr 1 13:02:15 2005 @@ -5126,8 +5126,13 @@ (defun slime-goto-definition (name definitions &optional where) (slime-push-definition-stack) - (cond ((slime-length> definitions 1) - (slime-show-definitions name definitions)) + (if (slime-length> definitions 1) + (slime-show-definitions name definitions) + (let ((def (car definitions))) + (destructure-case (slime-definition.location def) + ;; Take care of errors before switching any windows/buffers. + ((:error message) + (error "%s" message)) (t (cond ((equal where 'window) (slime-goto-definition-other-window (car definitions))) @@ -5137,7 +5142,7 @@ (t (slime-goto-source-location (slime-definition.location (car definitions))) - (switch-to-buffer (current-buffer))))))) + (switch-to-buffer (current-buffer))))))))) (defun slime-goto-definition-other-window (definition) (slime-pop-to-other-window) From lgorrie at common-lisp.net Fri Apr 1 11:03:28 2005 From: lgorrie at common-lisp.net (Luke Gorrie) Date: Fri, 1 Apr 2005 13:03:28 +0200 (CEST) Subject: [slime-cvs] CVS update: slime/ChangeLog Message-ID: <20050401110328.B435C884E2@common-lisp.net> Update of /project/slime/cvsroot/slime In directory common-lisp.net:/tmp/cvs-serv16303 Modified Files: ChangeLog Log Message: *** empty log message *** Date: Fri Apr 1 13:03:27 2005 Author: lgorrie Index: slime/ChangeLog diff -u slime/ChangeLog:1.652 slime/ChangeLog:1.653 --- slime/ChangeLog:1.652 Fri Apr 1 10:43:18 2005 +++ slime/ChangeLog Fri Apr 1 13:03:26 2005 @@ -1,3 +1,8 @@ +2005-04-01 Luke Gorrie + + * slime.el (slime-goto-definition): Handle :error locations here + before any window/buffer changes are made. + 2005-04-01 Matthias Koeppe * slime.el (slime-keys): Bind slime-edit-definition-other-window From lgorrie at common-lisp.net Fri Apr 1 13:59:50 2005 From: lgorrie at common-lisp.net (Luke Gorrie) Date: Fri, 1 Apr 2005 15:59:50 +0200 (CEST) Subject: [slime-cvs] CVS update: slime/swank-source-path-parser.lisp Message-ID: <20050401135950.5B1618866C@common-lisp.net> Update of /project/slime/cvsroot/slime In directory common-lisp.net:/tmp/cvs-serv25699 Modified Files: swank-source-path-parser.lisp Log Message: (check-source-path): Signal an error if a source path is malformed. SBCL sometimes gives (NIL). (source-path-stream-position): Use it. Date: Fri Apr 1 15:59:49 2005 Author: lgorrie Index: slime/swank-source-path-parser.lisp diff -u slime/swank-source-path-parser.lisp:1.12 slime/swank-source-path-parser.lisp:1.13 --- slime/swank-source-path-parser.lisp:1.12 Fri Mar 18 23:34:34 2005 +++ slime/swank-source-path-parser.lisp Fri Apr 1 15:59:48 2005 @@ -78,9 +78,15 @@ (defun source-path-stream-position (path stream) "Search the source-path PATH in STREAM and return its position." + (check-source-path path) (destructuring-bind (tlf-number . path) path (multiple-value-bind (form source-map) (read-source-form tlf-number stream) (source-path-source-position (cons 0 path) form source-map)))) + +(defun check-source-path (path) + (unless (and (consp path) + (every #'integerp path)) + (error "The source-path ~S is not valid." path))) (defun source-path-string-position (path string) (with-input-from-string (s string) From lgorrie at common-lisp.net Fri Apr 1 14:09:53 2005 From: lgorrie at common-lisp.net (Luke Gorrie) Date: Fri, 1 Apr 2005 16:09:53 +0200 (CEST) Subject: [slime-cvs] CVS update: slime/ChangeLog Message-ID: <20050401140953.7DDCD8866C@common-lisp.net> Update of /project/slime/cvsroot/slime In directory common-lisp.net:/tmp/cvs-serv26529 Modified Files: ChangeLog Log Message: *** empty log message *** Date: Fri Apr 1 16:09:52 2005 Author: lgorrie Index: slime/ChangeLog diff -u slime/ChangeLog:1.653 slime/ChangeLog:1.654 --- slime/ChangeLog:1.653 Fri Apr 1 13:03:26 2005 +++ slime/ChangeLog Fri Apr 1 16:09:52 2005 @@ -1,5 +1,9 @@ 2005-04-01 Luke Gorrie + * swank-source-path-parser.lisp (check-source-path): Signal an + error if a source path is malformed. SBCL sometimes gives (NIL). + (source-path-stream-position): Use it. + * slime.el (slime-goto-definition): Handle :error locations here before any window/buffer changes are made. From lgorrie at common-lisp.net Fri Apr 1 18:24:55 2005 From: lgorrie at common-lisp.net (Luke Gorrie) Date: Fri, 1 Apr 2005 20:24:55 +0200 (CEST) Subject: [slime-cvs] CVS update: slime/metering.lisp Message-ID: <20050401182455.4FCDC8866C@common-lisp.net> Update of /project/slime/cvsroot/slime In directory common-lisp.net:/tmp/cvs-serv8570 Modified Files: metering.lisp Log Message: Now supports only CLISP and OpenMCL. Removed a lot of really ugly reader-conditionalized code, much of it for archaic lisps (#+cltl2, #+lcl3.0, #+mcl1.3.2, etc). Date: Fri Apr 1 20:24:54 2005 Author: lgorrie Index: slime/metering.lisp diff -u slime/metering.lisp:1.2 slime/metering.lisp:1.3 --- slime/metering.lisp:1.2 Mon Sep 13 07:35:14 2004 +++ slime/metering.lisp Fri Apr 1 20:24:53 2005 @@ -1,6 +1,5 @@ ;;; -*- Mode: LISP; Package: monitor; Syntax: Common-lisp; Base: 10.; -*- ;;; Tue Jan 25 18:32:28 1994 by Mark Kantrowitz -;;; metering.cl -- 56711 bytes ;;; **************************************************************** ;;; Metering System ************************************************ @@ -22,7 +21,7 @@ ;;; This code is in the public domain and is distributed without warranty ;;; of any kind. ;;; -;;; Bug reports, comments, and suggestions should be sent to mkant at cs.cmu.edu. +;;; This copy is from SLIME, http://www.common-lisp.net/project/slime/ ;;; ;;; @@ -58,7 +57,10 @@ ;;; 01-JAN-93 mk v2.0 Support for MCL 2.0, CMU CL 16d, Allegro V3.1/4.0/4.1, ;;; Lucid 4.0, ibcl ;;; 25-JAN-94 mk v2.1 Patches for CLISP from Bruno Haible. - +;;; 01-APR-05 lgorrie Removed support for all Lisps except CLISP and OpenMCL. +;;; Purely to cut down on stale code (e.g. #+cltl2) in this +;;; version that is bundled with SLIME. +;;; ;;; ;;; ******************************** @@ -345,56 +347,18 @@ ;;; **************************************************************** ;;; ******************************** -;;; Fix up the *features* list ***** +;;; Warn people using the wrong Lisp ;;; ******************************** -(eval-when (compile load eval) - ;; The *features* list for Macintosh Allegro Common Lisp 1.3.2 - ;; isn't really unambiguous, so we add the :mcl1.3.2 feature. - (when (or (and (string-equal (lisp-implementation-type) - "Macintosh Allegro Common Lisp") - (string-equal (lisp-implementation-version) - "1.3.2")) - (and (find :ccl *features*) - (not (find :lispworks *features*)) - (not (find :mcl *features*)))) - (pushnew :mcl1.3.2 *features*)) - ;; We assume that :mcl means version 2.0 or greater. If it doesn't, - ;; use :mcl2.0 which is defined by: - (when (or (and (string-equal (lisp-implementation-type) - "Macintosh Common Lisp") - (string-equal (lisp-implementation-version) - "Version 2.0")) - (and (find :ccl *features*) - (find :ccl-2 *features*) - (not (find :lispworks *features*)) - (find :mcl *features*))) - (pushnew :mcl2.0 *features*)) - ) - -;;; Let's be smart about CLtL2 compatible Lisps: -(eval-when (compile load eval) - #+(or (and :excl (or :allegro-v4.0 (and :allegro-version>= (version>= 4 1)))) - :mcl - :cmu) - (pushnew :cltl2 *features*)) +#-(or clisp openmcl) +(warn "metering.lisp does not support your Lisp implementation!") ;;; ******************************** ;;; Packages *********************** ;;; ******************************** -#-(or cltl2 ansi-cl) -(in-package "MONITOR" :nicknames '("MON")) - ;;; For CLtL2 compatible lisps -#+(and :excl (or :allegro-v4.0 (and :allegro-version>= (version>= 4 1)))) -(defpackage "MONITOR" (:nicknames "MON") (:use "COMMON-LISP") - (:import-from cltl1 provide require)) -#+:mcl -(defpackage "MONITOR" (:nicknames "MON") (:use "COMMON-LISP") - (:import-from ccl provide require)) -#+(or :clisp :lispworks :cmu :sbcl) (defpackage "MONITOR" (:nicknames "MON") (:use "COMMON-LISP") (:export "*MONITORED-FUNCTIONS*" "MONITOR" "MONITOR-ALL" "UNMONITOR" "MONITOR-FORM" @@ -405,44 +369,8 @@ "DISPLAY-MONITORING-RESULTS" "MONITORING-ENCAPSULATE" "MONITORING-UNENCAPSULATE" "REPORT")) -#+(and :cltl2 - (not (or (and :excl (or :allegro-v4.0 (and :allegro-version>= - (version>= 4 1)))) - :mcl :clisp :lispworks - :cmu))) -(unless (find-package "MONITOR") - (make-package "MONITOR" :nicknames '("MON") :use '("COMMON-LISP"))) - -#+(or cltl2 ansi-cl) (in-package "MONITOR") - -#+(and :excl :allegro-v4.0) -(cltl1:provide "monitor") -#+(and :excl :allegro-version>= (version>= 4 1) :openmcl) -(provide "monitor") -#+(and :mcl (not :openmcl)) -(ccl:provide "monitor") -#+(and :cltl2 - (not (or (and :excl (or :allegro-v4.0 (and :allegro-version>= - (version>= 4 1)))) - :mcl - :cmu))) -(provide "monitor") -#-:cltl2 -(provide "monitor") - -(export '(*monitored-functions* - monitor monitor-all unmonitor monitor-form - with-monitoring - reset-monitoring-info reset-all-monitoring - monitored - report-monitoring - display-monitoring-results - monitoring-encapsulate monitoring-unencapsulate - report)) - - ;;; Warn user if they're loading the source instead of compiling it first. (eval-when (eval) (warn "This file should be compiled before loading for best results.")) @@ -460,36 +388,21 @@ ;;; **************************************************************** ;;; ******************************** -;;; Type Definitions *************** -;;; ******************************** - -#+(or cmu sbcl) -(eval-when (compile load eval) - (deftype time-type () '(unsigned-byte 32)) - (deftype consing-type () '(unsigned-byte 32))) - -;;; ******************************** ;;; Timing Functions *************** ;;; ******************************** ;;; The get-time function is called to find the total number of ticks since ;;; the beginning of time. time-units-per-second allows us to convert units ;;; to seconds. -(progn - #-(or :cmu - :clisp - :allegro-v3.1 :allegro-v4.0 :allegro-v4.1 :allegro-v5.0.1 - :mcl :mcl1.3.2 - :lcl3.0 :lcl4.0) - (eval-when (compile eval) - (warn - "You may want to supply implementation-specific get-time functions.")) +#-(or clisp openmcl) +(eval-when (compile eval) + (warn + "You may want to supply implementation-specific get-time functions.")) - (defconstant time-units-per-second internal-time-units-per-second) +(defconstant time-units-per-second internal-time-units-per-second) - (defmacro get-time () - `(the time-type (get-internal-run-time))) -) +(defmacro get-time () + `(the time-type (get-internal-run-time))) ;;; NOTE: In Macintosh Common Lisp, CCL::GCTIME returns the number of ;;; milliseconds spent during GC. We could subtract this from @@ -500,8 +413,8 @@ ;;; cost of doing business, and will average out in the long run. ;;; If it seems really important to a user that GC times not be ;;; counted, then uncomment the following three lines and read-time -;;; conditionalize the definition of get-time above with #-:mcl. -;#+:mcl +;;; conditionalize the definition of get-time above with #-:openmcl. +;#+openmcl ;(defmacro get-time () ; `(the time-type (- (get-internal-run-time) (ccl:gctime)))) @@ -511,107 +424,13 @@ ;;; The get-cons macro is called to find the total number of bytes ;;; consed since the beginning of time. -#+:cmu -(defmacro get-cons () - "The get-cons macro is called to find the total number of bytes - consed since the beginning of time." -; #-:new-compiler -; '(ext:get-bytes-consed) -; #+:new-compiler - '(the consing-type (ext:get-bytes-consed))) - -#+:clisp +#+clisp (defun get-cons () (multiple-value-bind (real1 real2 run1 run2 gc1 gc2 space1 space2 gccount) (sys::%%time) (declare (ignore real1 real2 run1 run2 gc1 gc2 gccount)) (dpb space1 (byte 24 24) space2))) -;;; Lucid. 4 bytes/word. This returns bytes. -;;; For some reason this doesn't work properly under Lucid 4.0, but -;;; that's OK, because they have PC-based profiling which is more accurate. -#+(or :lcl3.0 :lcl4.0) -(defmacro get-cons () `(the consing-type (gc-size))) - -;;; Allegro V4.0/1. SYS::GSGC-MAP takes one argument, and returns an -;;; array representing the memory state. -#+(or :allegro-v4.0 :allegro-v4.1 :allegro-v5.0.1) -(defvar *gc-space-array* (make-array 4 :element-type '(unsigned-byte 32))) -#+(or :allegro-v4.0 :allegro-v4.1 :allegro-v5.0.1) -(defun bytes-consed () - (system::gsgc-totalloc *gc-space-array* t) - (aref *gc-space-array* 0)) - -#+:allegro-v3.1 -(defun bytes-consed () - (let ((gs (sys::gsgc-map))) - (+ (aref gs 3) ; new space - (let ((sum 0)) ; old space - (dotimes (i (1+ (floor (/ (- (length gs) 13) 10)))) - (incf sum (aref gs (+ (* i 10) 13)))) - sum))) - ) - -#+(or :allegro-v3.1 :allegro-v4.0 :allegro-v4.1 :allegro-v5.0.1) -(defmacro get-cons () `(the consing-type (bytes-consed))) - -;;; Macintosh Allegro Common Lisp 1.3.2 -;;; Based on CCL's sample code for memory usage. -;;; They key trick here is that we maintain the information about total -;;; consing since time zero by keeping track of how much memory was free -;;; before and after gc (by advising gc). Luckily, MACL's garbage collection -;;; seems to always be invoked internally by calling GC. -;;; -;;; Maybe instead of showing bytes consed since time zero, we should -;;; return bytes consed since the first time the function is called? -;;; And the first time the function is called, it should set the -;;; value to zero. No real need to do this -- what we have works fine, -;;; and involves less code. -#+:mcl1.3.2 -(in-package :ccl) - -#+:mcl1.3.2 -(defvar *bytes-consed-chkpt* 0) - -#+:mcl1.3.2 -(defun reset-consing () (setq *bytes-consed-chkpt* 0)) - -(eval-when (eval compile) - #+:mcl1.3.2(defconstant $currentA5 #x904) - #+:mcl1.3.2(defconstant $pagecounts #x-18e) - #+:mcl1.3.2(defconstant $lstFP #x-a42) - #+:mcl1.3.2(defconstant $consfirstob 64) - #+:mcl1.3.2(defconstant $pagesize 4096)) - -#+:mcl1.3.2 -(let ((old-gc (symbol-function 'gc)) - (ccl:*warn-if-redefine-kernel* nil)) - (setf (symbol-function 'gc) - #'(lambda () - (let ((old-consing (total-bytes-consed))) - (prog1 - (funcall old-gc) - (incf *bytes-consed-chkpt* - (- old-consing (total-bytes-consed)))))))) - -#+:mcl1.3.2 -(defun total-bytes-consed (&aux pages fp) - "Returns number of conses (8 bytes each)" - (let* ((a5 (%get-ptr $currentA5)) - (ptr (%inc-ptr a5 $pagecounts))) - (%ilsr 3 (%i+ (%i- (%ilsl 12 (%i- (setq pages (%get-word ptr 0)) 1)) - (%i* pages $consfirstob)) - (if (eq 0 (setq fp (%get-long a5 $lstFP))) - $pagesize - (%ilogand2 #xfff fp)))))) - -#+:mcl1.3.2 -(in-package "MONITOR") - -#+:mcl1.3.2 -(defun get-cons () - (the consing-type (+ (ccl::total-bytes-consed) ccl::*bytes-consed-chkpt*))) - ;;; Macintosh Common Lisp 2.0 ;;; Note that this includes bytes that were allocated during GC. ;;; We could subtract this out by advising GC like we did under @@ -621,40 +440,30 @@ ;;; avoid the consing values being too lopsided. If a user really really ;;; wants to subtract out the consing during GC, replace the following ;;; two lines with the commented out code. -#+:mcl -(defmacro get-cons () `(the consing-type (ccl::total-bytes-allocated))) -;#+:mcl -;(in-package :ccl) -;#+:mcl -;(defvar *bytes-consed-chkpt* 0) -;#+:mcl -;(defun reset-consing () (setq *bytes-consed-chkpt* 0)) -;#+:mcl -;(let ((old-gc (symbol-function 'gc)) -; (ccl:*warn-if-redefine-kernel* nil)) -; (setf (symbol-function 'gc) -; #'(lambda () -; (let ((old-consing (total-bytes-consed))) -; (prog1 -; (funcall old-gc) -; (incf *bytes-consed-chkpt* -; (- old-consing (total-bytes-consed)))))))) -;#+:mcl -;(defun total-bytes-consed () -; "Returns number of conses (8 bytes each)" -; (ccl::total-bytes-allocated)) -;#+:mcl -;(in-package "MONITOR") -;#+:mcl -;(defun get-cons () -; (the consing-type (+ (ccl::total-bytes-consed) ccl::*bytes-consed-chkpt*))) - - -#-(or :cmu - :clisp - :lcl3.0 :lcl4.0 - :allegro-v3.1 :allegro-v4.0 :allegro-v4.1 :allegro-v5.0.1 - :mcl1.3.2 :mcl) +#+openmcl +(progn + (defmacro get-cons () `(the consing-type (ccl::total-bytes-allocated))) + (in-package :ccl) + (defvar *bytes-consed-chkpt* 0) + (defun reset-consing () (setq *bytes-consed-chkpt* 0)) + (let ((old-gc (symbol-function 'gc)) + (ccl:*warn-if-redefine-kernel* nil)) + (setf (symbol-function 'gc) + #'(lambda () + (let ((old-consing (total-bytes-consed))) + (prog1 + (funcall old-gc) + (incf *bytes-consed-chkpt* + (- old-consing (total-bytes-consed)))))))) + (defun total-bytes-consed () + "Returns number of conses (8 bytes each)" + (ccl::total-bytes-allocated)) + (in-package "MONITOR") + (defun get-cons () + (the consing-type (+ (ccl::total-bytes-consed) ccl::*bytes-consed-chkpt*)))) + + +#-(or clisp openmcl) (progn (eval-when (compile eval) (warn "No consing will be reported unless a get-cons function is ~ @@ -676,46 +485,46 @@ (,delta-cons (- (get-cons) ,start-cons))) , at post-process))))) -#+:clisp -(defmacro delta4 (nv1 nv2 ov1 ov2 by) - `(- (dpb (- ,nv1 ,ov1) (byte ,by ,by) ,nv2) ,ov2)) -#+:clisp ; CLISP 2.29 built-in -(let ((del (find-symbol "DELTA4" "SYS"))) - (when del (setf (fdefinition 'delta4) (fdefinition del)))) -#+:clisp -(if (< internal-time-units-per-second 1000000) - ;; TIME_1: AMIGA, OS/2, UNIX_TIMES - (defmacro delta4-time (new-time1 new-time2 old-time1 old-time2) - `(delta4 ,new-time1 ,new-time2 ,old-time1 ,old-time2 16)) - ;; TIME_2: other UNIX, WIN32 - (defmacro delta4-time (new-time1 new-time2 old-time1 old-time2) - `(+ (* (- ,new-time1 ,old-time1) internal-time-units-per-second) - (- ,new-time2 ,old-time2)))) -#+:clisp -(defmacro delta4-cons (new-cons1 new-cons2 old-cons1 old-cons2) - `(delta4 ,new-cons1 ,new-cons2 ,old-cons1 ,old-cons2 24)) - -;; avoid consing: when the application conses a lot, -;; get-cons may return a bignum, so we really should not use it. -#+:clisp -(defmacro with-time/cons ((delta-time delta-cons) form &body post-process) - (let ((beg-cons1 (gensym "BEG-CONS1-")) (end-cons1 (gensym "END-CONS1-")) - (beg-cons2 (gensym "BEG-CONS2-")) (end-cons2 (gensym "END-CONS2-")) - (beg-time1 (gensym "BEG-TIME1-")) (end-time1 (gensym "END-TIME1-")) - (beg-time2 (gensym "BEG-TIME2-")) (end-time2 (gensym "END-TIME2-")) - (re1 (gensym)) (re2 (gensym)) (gc1 (gensym)) (gc2 (gensym))) - `(multiple-value-bind (,re1 ,re2 ,beg-time1 ,beg-time2 - ,gc1 ,gc2 ,beg-cons1 ,beg-cons2) (sys::%%time) - (declare (ignore ,re1 ,re2 ,gc1 ,gc2)) - (multiple-value-prog1 ,form - (multiple-value-bind (,re1 ,re2 ,end-time1 ,end-time2 - ,gc1 ,gc2 ,end-cons1 ,end-cons2) (sys::%%time) - (declare (ignore ,re1 ,re2 ,gc1 ,gc2)) - (let ((,delta-time (delta4-time ,end-time1 ,end-time2 - ,beg-time1 ,beg-time2)) - (,delta-cons (delta4-cons ,end-cons1 ,end-cons2 - ,beg-cons1 ,beg-cons2))) - , at post-process)))))) +#+clisp +(progn + (defmacro delta4 (nv1 nv2 ov1 ov2 by) + `(- (dpb (- ,nv1 ,ov1) (byte ,by ,by) ,nv2) ,ov2)) + + (let ((del (find-symbol "DELTA4" "SYS"))) + (when del (setf (fdefinition 'delta4) (fdefinition del)))) + + (if (< internal-time-units-per-second 1000000) + ;; TIME_1: AMIGA, OS/2, UNIX_TIMES + (defmacro delta4-time (new-time1 new-time2 old-time1 old-time2) + `(delta4 ,new-time1 ,new-time2 ,old-time1 ,old-time2 16)) + ;; TIME_2: other UNIX, WIN32 + (defmacro delta4-time (new-time1 new-time2 old-time1 old-time2) + `(+ (* (- ,new-time1 ,old-time1) internal-time-units-per-second) + (- ,new-time2 ,old-time2)))) + + (defmacro delta4-cons (new-cons1 new-cons2 old-cons1 old-cons2) + `(delta4 ,new-cons1 ,new-cons2 ,old-cons1 ,old-cons2 24)) + + ;; avoid consing: when the application conses a lot, + ;; get-cons may return a bignum, so we really should not use it. + (defmacro with-time/cons ((delta-time delta-cons) form &body post-process) + (let ((beg-cons1 (gensym "BEG-CONS1-")) (end-cons1 (gensym "END-CONS1-")) + (beg-cons2 (gensym "BEG-CONS2-")) (end-cons2 (gensym "END-CONS2-")) + (beg-time1 (gensym "BEG-TIME1-")) (end-time1 (gensym "END-TIME1-")) + (beg-time2 (gensym "BEG-TIME2-")) (end-time2 (gensym "END-TIME2-")) + (re1 (gensym)) (re2 (gensym)) (gc1 (gensym)) (gc2 (gensym))) + `(multiple-value-bind (,re1 ,re2 ,beg-time1 ,beg-time2 + ,gc1 ,gc2 ,beg-cons1 ,beg-cons2) (sys::%%time) + (declare (ignore ,re1 ,re2 ,gc1 ,gc2)) + (multiple-value-prog1 ,form + (multiple-value-bind (,re1 ,re2 ,end-time1 ,end-time2 + ,gc1 ,gc2 ,end-cons1 ,end-cons2) (sys::%%time) + (declare (ignore ,re1 ,re2 ,gc1 ,gc2)) + (let ((,delta-time (delta4-time ,end-time1 ,end-time2 + ,beg-time1 ,beg-time2)) + (,delta-cons (delta4-cons ,end-cons1 ,end-cons2 + ,beg-cons1 ,beg-cons2))) + , at post-process))))))) ;;; ******************************** ;;; Required Arguments ************* @@ -728,71 +537,12 @@ ;;; arguments. The function Required-Arguments returns two values: the first ;;; is the number of required arguments, and the second is T iff there are any ;;; non-required arguments (e.g. &optional, &rest, &key). -#+cmu -(progn - #| #-new-compiler - (defun required-arguments (name) - (let ((function (symbol-function name))) - (if (eql (system:%primitive get-type function) system:%function-type) - (let ((min (ldb system:%function-min-args-byte - (system:%primitive header-ref function - system:%function-min-args-slot))) - (max (ldb system:%function-max-args-byte - (system:%primitive header-ref function - system:%function-max-args-slot))) - (rest (ldb system:%function-rest-arg-byte - (system:%primitive header-ref function - system:%function-rest-arg-slot))) - (key (ldb system:%function-keyword-arg-byte - (system:%primitive - header-ref function - system:%function-keyword-arg-slot)))) - (values min (or (/= min max) (/= rest 0) (/= key 0)))) - (values 0 t)))) - |# - #| #+new-compiler - (defun required-arguments (name) - (let* ((function (symbol-function name)) - (stype (system:%primitive get-vector-subtype function))) - (if (eql stype system:%function-entry-subtype) - (let* ((args (cadr (system:%primitive - header-ref - function - system:%function-entry-type-slot))) - (pos (position-if #'(lambda (x) - (and (symbolp x) - (let ((name (symbol-name x))) - (and (>= (length name) 1) - (char= (schar name 0) - #\&))))) - args))) - (if pos - (values pos t) - (values (length args) nil))) - (values 0 t)))))|# - - (defun required-arguments (name) - (let ((type (ext:info function type name))) - (cond ((not (kernel:function-type-p type)) - (warn "No argument count information available for:~% ~S~@ - Allow for &rest arg consing." - name) - (values 0 t)) - (t - (values (length (kernel:function-type-required type)) - (if (or (kernel:function-type-optional type) - (kernel:function-type-keyp type) - (kernel:function-type-rest type)) - t nil)))))) -) ;;; Lucid, Allegro, and Macintosh Common Lisp -#+(OR :lcl3.0 :lcl4.0 :excl :mcl) +#+openmcl (defun required-arguments (name) (let* ((function (symbol-function name)) - (args #+:excl(excl::arglist function) - #+:mcl(ccl:arglist function) - #-(or :excl :mcl)(arglist function)) + (args (ccl:arglist function)) (pos (position-if #'(lambda (x) (and (symbolp x) (let ((name (symbol-name x))) @@ -804,30 +554,7 @@ (values pos t) (values (length args) nil)))) -;;; Macintosh Allegro Common Lisp version 1.3.2 -#+:mcl1.3.2 -(defun required-arguments (name) - (let ((arguments-string - (let ((the-string - (with-output-to-string (*standard-output*) - (ccl:arglist-to-stream name *standard-output*)))) - (cond ((and (>= (length the-string) 23) - (string-equal (subseq the-string 0 22) - "Can't find arglist for")) nil) - ((position #\( the-string :test 'char-equal) the-string) - (T (concatenate 'string "(" the-string ")")))))) - (if (null arguments-string) - (values 0 t) - (let* ((pos (position #\& arguments-string)) - (args (length (read-from-string - (concatenate 'string - (subseq arguments-string 0 pos) - ")"))))) - (if pos - (values args t) - (values args nil)))))) - -#+:clisp +#+clisp (defun required-arguments (name) (multiple-value-bind (name req-num opt-num rest-p key-p keywords allow-p) (sys::function-signature name t) @@ -835,7 +562,7 @@ (values req-num (or (/= 0 opt-num) rest-p key-p keywords allow-p)) (values 0 t)))) -#-(or :cmu :clisp :lcl3.0 :lcl4.0 :mcl1.3.2 :mcl :excl) +#-(or clisp openmcl) (progn (eval-when (compile eval) (warn @@ -954,22 +681,10 @@ ;;; (defstruct metering-functions (name nil) - (old-definition #-cmu nil - #+cmu - (error "Missing required keyword argument :old-definition") - :type function) - (new-definition #-cmu nil - #+cmu - (error "Missing required keyword argument :new-definition") - :type function) - (read-metering #-cmu nil - #+cmu - (error "Missing required keyword argument :read-metering") - :type function) - (reset-metering #-cmu nil - #+cmu - (error "Missing required keyword argument :reset-metering") - :type function)) + (old-definition nil :type function) + (new-definition nil :type function) + (read-metering nil :type function) + (reset-metering nil :type function)) ;;; In general using hash tables in time-critical programs is a bad idea, ;;; because when one has to grow the table and rehash everything, the @@ -1078,8 +793,7 @@ (setf (place-function name) #'(lambda (, at required-args ,@(when optionals-p - #+cmu `(c:&more arg-context arg-count) - #-cmu `(&rest optional-args))) + `(&rest optional-args))) (let ((prev-total-time *total-time*) (prev-total-cons *total-cons*) (prev-total-calls *total-calls*) @@ -1093,14 +807,8 @@ (with-time/cons (delta-time delta-cons) ;; form ,(if optionals-p - #+cmu `(multiple-value-call - old-definition - (values , at required-args) - (c:%more-arg-values arg-context - 0 - arg-count)) - #-cmu `(apply old-definition - , at required-args optional-args) + `(apply old-definition + , at required-args optional-args) `(funcall old-definition , at required-args)) ;; post-processing: ;; Calls From lgorrie at common-lisp.net Fri Apr 1 18:31:37 2005 From: lgorrie at common-lisp.net (Luke Gorrie) Date: Fri, 1 Apr 2005 20:31:37 +0200 (CEST) Subject: [slime-cvs] CVS update: slime/ChangeLog Message-ID: <20050401183137.0FEBC8866C@common-lisp.net> Update of /project/slime/cvsroot/slime In directory common-lisp.net:/tmp/cvs-serv9405 Modified Files: ChangeLog Log Message: *** empty log message *** Date: Fri Apr 1 20:31:36 2005 Author: lgorrie Index: slime/ChangeLog diff -u slime/ChangeLog:1.654 slime/ChangeLog:1.655 --- slime/ChangeLog:1.654 Fri Apr 1 16:09:52 2005 +++ slime/ChangeLog Fri Apr 1 20:31:36 2005 @@ -1,5 +1,9 @@ 2005-04-01 Luke Gorrie + * metering.lisp: Now supports only CLISP and OpenMCL. + Removed a lot of really ugly reader-conditionalized code, much of + it for archaic lisps (#+cltl2, #+lcl3.0, #+mcl1.3.2, etc). + * swank-source-path-parser.lisp (check-source-path): Signal an error if a source path is malformed. SBCL sometimes gives (NIL). (source-path-stream-position): Use it. From heller at common-lisp.net Fri Apr 1 19:44:28 2005 From: heller at common-lisp.net (Helmut Eller) Date: Fri, 1 Apr 2005 21:44:28 +0200 (CEST) Subject: [slime-cvs] CVS update: slime/swank-allegro.lisp Message-ID: <20050401194428.7CA058866C@common-lisp.net> Update of /project/slime/cvsroot/slime In directory common-lisp.net:/tmp/cvs-serv12969 Modified Files: swank-allegro.lisp Log Message: (eval-in-frame): Allegro's eval-form-in-context does nothing special with lexical variables in the frame. Wrap an explicit LET around the form to get the similar behavior as in the other Lisps. (inspect-for-emacs (structure-object)): Remove structure related methods. It's already covered by the general case with allegro-inspect. (common-seperated-spec): Deleted Date: Fri Apr 1 21:44:27 2005 Author: heller Index: slime/swank-allegro.lisp diff -u slime/swank-allegro.lisp:1.72 slime/swank-allegro.lisp:1.73 --- slime/swank-allegro.lisp:1.72 Sat Mar 12 03:44:27 2005 +++ slime/swank-allegro.lisp Fri Apr 1 21:44:27 2005 @@ -146,9 +146,10 @@ (funcall debugger-loop-fn))) (defun find-topframe () - (do ((f (excl::int-newest-frame) (next-frame f)) - (i 0 (1+ i))) - ((= i 3) f))) + (let ((skip-frames 3)) + (do ((f (excl::int-newest-frame) (next-frame f)) + (i 0 (1+ i))) + ((= i skip-frames) f)))) (defun next-frame (frame) (let ((next (excl::int-next-older-frame frame))) @@ -196,9 +197,15 @@ (second (first (fspec-definition-locations fspec))))) (defimplementation eval-in-frame (form frame-number) - (debugger:eval-form-in-context - form - (debugger:environment-of-frame (nth-frame frame-number)))) + (let ((frame (nth-frame frame-number))) + ;; let-bind lexical variables + (let ((vars (loop for i below (debugger:frame-number-vars frame) + for name = (debugger:frame-var-name frame i) + if (symbolp name) + collect `(,name ',(debugger:frame-var-value frame i))))) + (debugger:eval-form-in-context + `(let* ,vars ,form) + (debugger:environment-of-frame frame))))) (defimplementation return-from-frame (frame-number form) (let ((frame (nth-frame frame-number))) @@ -472,14 +479,6 @@ (defimplementation make-default-inspector () (make-instance 'acl-inspector)) -;; 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 ", "))) - #-allegro-v5.0 (defmethod inspect-for-emacs ((f function) inspector) inspector @@ -491,83 +490,6 @@ (when doc `("Documentation:" (:newline) ,doc)))))) - -(defmethod inspect-for-emacs ((class structure-class) (inspector acl-inspector)) - (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)")))) - -#-allegro-v5.0 -(defmethod inspect-for-emacs ((slot excl::structure-slot-definition) - (inspector acl-inspector)) - (values "A structure slot." - `("Name: " (:value ,(swank-mop:slot-definition-name slot)) - (:newline) - "Documentation:" (:newline) - ,@(when (documentation slot t) - `((:value ,(documentation slot t)) (: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 inspect-for-emacs ((o structure-object) (inspector acl-inspector)) - (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))))) - (defmethod inspect-for-emacs ((o t) (inspector acl-inspector)) inspector (values "A value." (allegro-inspect o))) @@ -578,26 +500,23 @@ (defun allegro-inspect (o) (loop for (d dd) on (inspect::inspect-ctl o) - until (eq d dd) - for i from 0 - append (frob-allegro-field-def o d i))) + append (frob-allegro-field-def o d) + until (eq d dd))) -(defun frob-allegro-field-def (object def idx) +(defun frob-allegro-field-def (object def) (with-struct (inspect::field-def- name type access) def - (label-value-line name - (ecase type - ((:unsigned-word :unsigned-byte :unsigned-natural - :unsigned-half-long) - (inspect::component-ref-v object access type)) - (:lisp - (inspect::component-ref object access)) - (:indirect - (apply #'inspect::indirect-ref object idx access)))))) - -#| -(defun test (foo) - (inspect::show-object-structure foo (inspect::inspect-ctl foo) 1)) -|# + (ecase type + ((:unsigned-word :unsigned-byte :unsigned-natural + :unsigned-half-long :unsigned-3byte) + (label-value-line name (inspect::component-ref-v object access type))) + ((:lisp :value) + (label-value-line name (inspect::component-ref object access))) + (:indirect + (destructuring-bind (prefix count ref set) access + (declare (ignore set prefix)) + (loop for i below (funcall count object) + append (label-value-line (format nil "~A-~D" name i) + (funcall ref object i)))))))) ;;;; Multithreading From heller at common-lisp.net Fri Apr 1 19:55:19 2005 From: heller at common-lisp.net (Helmut Eller) Date: Fri, 1 Apr 2005 21:55:19 +0200 (CEST) Subject: [slime-cvs] CVS update: slime/swank.lisp Message-ID: <20050401195519.CA4D78866C@common-lisp.net> Update of /project/slime/cvsroot/slime In directory common-lisp.net:/tmp/cvs-serv13862 Modified Files: swank.lisp Log Message: (spawn-repl-thread): Use *default-worker-thread-bindings* just like spawn-worker-thread. (wrap-sldb-vars): New function. When evaluating a form in a frame, Allegro uses the "old" dynamic context, i.e., dynamic variables like *sldb-level* and the like are reset to the values in those frames. But if *sldb-level* is reset to 0, Emacs doesn't notice when a (recursive) error occurs while evaluating the form in the old frame. wrap-sldb-vars saves the debugger related variables to avoid such confusion. (eval-string-in-frame, pprint-eval-string-in-frame): Use it. Date: Fri Apr 1 21:55:18 2005 Author: heller Index: slime/swank.lisp diff -u slime/swank.lisp:1.290 slime/swank.lisp:1.291 --- slime/swank.lisp:1.290 Wed Mar 23 13:23:05 2005 +++ slime/swank.lisp Fri Apr 1 21:55:18 2005 @@ -496,8 +496,8 @@ (if (thread-alive-p thread) thread (setf (connection.repl-thread connection) - (spawn (lambda () (repl-loop connection)) - :name "new-repl-thread"))))) + (spawn-repl-thread connection "new-repl-thread"))))) + (defun find-worker-thread (id) (etypecase id @@ -530,6 +530,12 @@ (handle-request connection))) :name "worker")) +(defun spawn-repl-thread (connection name) + (spawn (lambda () + (with-bindings *default-worker-thread-bindings* + (repl-loop connection))) + :name name)) + (defun dispatch-event (event socket-io) "Handle an event triggered either by Emacs or within Lisp." (log-event "DISPATCHING: ~S~%" event) @@ -579,8 +585,7 @@ (read-loop control-thread socket-io connection))) :name "reader-thread")) - (repl-thread (spawn (lambda () (repl-loop connection)) - :name "repl-thread"))) + (repl-thread (spawn-repl-thread connection "repl-thread"))) (setf (connection.reader-thread connection) reader-thread) (setf (connection.repl-thread connection) repl-thread) connection))) @@ -1797,12 +1802,11 @@ then waits to handle further requests from Emacs. Eventually returns after Emacs causes a restart to be invoked." (declare (ignore hook)) - (flet ((debug-it () (debug-in-emacs condition))) - (cond (*emacs-connection* - (debug-it)) - ((default-connection) - (with-connection ((default-connection)) - (debug-in-emacs condition)))))) + (cond (*emacs-connection* + (debug-in-emacs condition)) + ((default-connection) + (with-connection ((default-connection)) + (debug-in-emacs condition))))) (defvar *global-debugger* t "Non-nil means the Swank debugger hook will be installed globally.") @@ -1850,15 +1854,15 @@ (unwind-protect (catch 'sldb-enter-default-debugger (send-to-emacs - (list* :debug (current-thread) *sldb-level* + (list* :debug (current-thread) level (debugger-info-for-emacs 0 *sldb-initial-frames*))) (loop (catch 'sldb-loop-catcher (with-simple-restart (abort "Return to sldb level ~D." level) (send-to-emacs (list :debug-activate (current-thread) - *sldb-level*)) + level)) (handler-bind ((sldb-condition #'handle-sldb-condition)) (read-from-emacs)))))) - (send-to-emacs `(:debug-return + (send-to-emacs `(:debug-return ,(current-thread) ,level ,*sldb-stepping-p*)))) (defun handle-sldb-condition (condition) @@ -1979,13 +1983,18 @@ (when (= sldb-level *sldb-level*) (invoke-nth-restart n))) +(defun wrap-sldb-vars (form) + `(let ((*sldb-level* ,*sldb-level*)) + ,form)) + (defslimefun eval-string-in-frame (string index) - (to-string (eval-in-frame (from-string string) index))) + (to-string (eval-in-frame (wrap-sldb-vars (from-string string)) + index))) (defslimefun pprint-eval-string-in-frame (string index) (swank-pprint (multiple-value-list - (eval-in-frame (from-string string) index)))) + (eval-in-frame (wrap-sldb-vars (from-string string)) index)))) (defslimefun frame-locals-for-emacs (index) "Return a property list ((&key NAME ID VALUE) ...) describing From heller at common-lisp.net Fri Apr 1 19:58:23 2005 From: heller at common-lisp.net (Helmut Eller) Date: Fri, 1 Apr 2005 21:58:23 +0200 (CEST) Subject: [slime-cvs] CVS update: slime/slime.el Message-ID: <20050401195823.35EC88866C@common-lisp.net> Update of /project/slime/cvsroot/slime In directory common-lisp.net:/tmp/cvs-serv13925 Modified Files: slime.el Log Message: (sldb-get-buffer): Initialize the buffer local variables slime-buffer-connection and slime-current-thread when create a fresh buffer. Date: Fri Apr 1 21:58:20 2005 Author: heller Index: slime/slime.el diff -u slime/slime.el:1.476 slime/slime.el:1.477 --- slime/slime.el:1.476 Fri Apr 1 13:02:15 2005 +++ slime/slime.el Fri Apr 1 21:58:20 2005 @@ -1492,7 +1492,8 @@ (defvar slime-net-coding-system (find-if (if (featurep 'xemacs) #'find-coding-system #'coding-system-p) '(iso-latin-1-unix iso-8859-1-unix binary)) - "*Coding system used for network connections.") + "*Coding system used for network connections. +See also `slime-net-valid-coding-systems'.") (defvar slime-net-valid-coding-systems '((iso-latin-1-unix nil :iso-latin-1-unix) @@ -6354,8 +6355,8 @@ (eq major-mode 'sldb-mode))) (buffer-list))) -(defun sldb-find-buffer (thread) - (let ((connection (slime-connection))) +(defun sldb-find-buffer (thread &optional connection) + (let ((connection (or connection (slime-connection)))) (find-if (lambda (buffer) (with-current-buffer buffer (and (eq slime-buffer-connection connection) @@ -6367,11 +6368,15 @@ The buffer is chosen more or less randomly." (car (sldb-buffers))) -(defun sldb-get-buffer (thread) +(defun sldb-get-buffer (thread &optional connection) "Find or create a sldb-buffer for THREAD." - (or (sldb-find-buffer thread) - (get-buffer-create - (format "*sldb %s/%s*" (slime-connection-name) thread)))) + (let ((connection (or connection (slime-connection)))) + (or (sldb-find-buffer thread connection) + (let ((name (format "*sldb %s/%s*" (slime-connection-name) thread))) + (with-current-buffer (get-buffer-create name) + (setq slime-buffer-connection connection + slime-current-thread thread) + (current-buffer)))))) (defun sldb-debugged-continuations (connection) "Return the debugged continuations for CONNECTION." From heller at common-lisp.net Fri Apr 1 20:02:14 2005 From: heller at common-lisp.net (Helmut Eller) Date: Fri, 1 Apr 2005 22:02:14 +0200 (CEST) Subject: [slime-cvs] CVS update: slime/ChangeLog Message-ID: <20050401200214.C37908866C@common-lisp.net> Update of /project/slime/cvsroot/slime In directory common-lisp.net:/tmp/cvs-serv14719 Modified Files: ChangeLog Log Message: *** empty log message *** Date: Fri Apr 1 22:02:10 2005 Author: heller Index: slime/ChangeLog diff -u slime/ChangeLog:1.655 slime/ChangeLog:1.656 --- slime/ChangeLog:1.655 Fri Apr 1 20:31:36 2005 +++ slime/ChangeLog Fri Apr 1 22:02:09 2005 @@ -1,3 +1,24 @@ +2005-04-01 Helmut Eller + + * slime.el (sldb-get-buffer): Initialize the buffer local + variables slime-buffer-connection and slime-current-thread when + creating a fresh buffer. + + * swank.lisp (spawn-repl-thread): Use + *default-worker-thread-bindings* just like spawn-worker-thread. + (wrap-sldb-vars): New function. Rebind *sldb-level* to avoid + confusion with recursive errors during eval-in-frame. + (eval-string-in-frame, pprint-eval-string-in-frame): Use it. + + * swank-allegro.lisp (eval-in-frame): Allegro's + eval-form-in-context does nothing special with lexical variables + in the frame. Wrap an explicit LET around the form to get similar + behavior as in the other Lisps. + (inspect-for-emacs (structure-object)): Remove structure related + methods. It's already covered by the general case with + allegro-inspect. + (common-seperated-spec): Deleted + 2005-04-01 Luke Gorrie * metering.lisp: Now supports only CLISP and OpenMCL. From lgorrie at common-lisp.net Fri Apr 1 20:16:36 2005 From: lgorrie at common-lisp.net (Luke Gorrie) Date: Fri, 1 Apr 2005 22:16:36 +0200 (CEST) Subject: [slime-cvs] CVS update: slime/metering.lisp Message-ID: <20050401201636.6F6CA8866C@common-lisp.net> Update of /project/slime/cvsroot/slime In directory common-lisp.net:/tmp/cvs-serv15671 Modified Files: metering.lisp Log Message: Maybe fixed some openmcl breakage. Date: Fri Apr 1 22:16:35 2005 Author: lgorrie Index: slime/metering.lisp diff -u slime/metering.lisp:1.3 slime/metering.lisp:1.4 --- slime/metering.lisp:1.3 Fri Apr 1 20:24:53 2005 +++ slime/metering.lisp Fri Apr 1 22:16:35 2005 @@ -441,26 +441,27 @@ ;;; wants to subtract out the consing during GC, replace the following ;;; two lines with the commented out code. #+openmcl -(progn - (defmacro get-cons () `(the consing-type (ccl::total-bytes-allocated))) - (in-package :ccl) - (defvar *bytes-consed-chkpt* 0) - (defun reset-consing () (setq *bytes-consed-chkpt* 0)) - (let ((old-gc (symbol-function 'gc)) - (ccl:*warn-if-redefine-kernel* nil)) - (setf (symbol-function 'gc) - #'(lambda () - (let ((old-consing (total-bytes-consed))) - (prog1 - (funcall old-gc) - (incf *bytes-consed-chkpt* - (- old-consing (total-bytes-consed)))))))) - (defun total-bytes-consed () - "Returns number of conses (8 bytes each)" - (ccl::total-bytes-allocated)) - (in-package "MONITOR") - (defun get-cons () - (the consing-type (+ (ccl::total-bytes-consed) ccl::*bytes-consed-chkpt*)))) +(defmacro get-cons () `(the consing-type (ccl::total-bytes-allocated))) +;; #+openmcl +;; (progn +;; (in-package :ccl) +;; (defvar *bytes-consed-chkpt* 0) +;; (defun reset-consing () (setq *bytes-consed-chkpt* 0)) +;; (let ((old-gc (symbol-function 'gc)) +;; (ccl:*warn-if-redefine-kernel* nil)) +;; (setf (symbol-function 'gc) +;; #'(lambda () +;; (let ((old-consing (total-bytes-consed))) +;; (prog1 +;; (funcall old-gc) +;; (incf *bytes-consed-chkpt* +;; (- old-consing (total-bytes-consed)))))))) +;; (defun total-bytes-consed () +;; "Returns number of conses (8 bytes each)" +;; (ccl::total-bytes-allocated)) +;; (in-package "MONITOR") +;; (defun get-cons () +;; (the consing-type (+ (ccl::total-bytes-consed) ccl::*bytes-consed-chkpt*)))) #-(or clisp openmcl) From lgorrie at common-lisp.net Fri Apr 1 21:57:43 2005 From: lgorrie at common-lisp.net (Luke Gorrie) Date: Fri, 1 Apr 2005 23:57:43 +0200 (CEST) Subject: [slime-cvs] CVS update: slime/ChangeLog Message-ID: <20050401215743.1D4108866C@common-lisp.net> Update of /project/slime/cvsroot/slime In directory common-lisp.net:/tmp/cvs-serv20884 Modified Files: ChangeLog Log Message: (slime-xref-mode): Summarise the most important bindings in the mode description. Date: Fri Apr 1 23:57:42 2005 Author: lgorrie Index: slime/ChangeLog diff -u slime/ChangeLog:1.656 slime/ChangeLog:1.657 --- slime/ChangeLog:1.656 Fri Apr 1 22:02:09 2005 +++ slime/ChangeLog Fri Apr 1 23:57:42 2005 @@ -21,6 +21,9 @@ 2005-04-01 Luke Gorrie + * slime.el (slime-xref-mode): Summarise the most important + bindings in the mode description. + * metering.lisp: Now supports only CLISP and OpenMCL. Removed a lot of really ugly reader-conditionalized code, much of it for archaic lisps (#+cltl2, #+lcl3.0, #+mcl1.3.2, etc). From lgorrie at common-lisp.net Fri Apr 1 21:57:56 2005 From: lgorrie at common-lisp.net (Luke Gorrie) Date: Fri, 1 Apr 2005 23:57:56 +0200 (CEST) Subject: [slime-cvs] CVS update: slime/slime.el Message-ID: <20050401215756.71E06886FA@common-lisp.net> Update of /project/slime/cvsroot/slime In directory common-lisp.net:/tmp/cvs-serv20913 Modified Files: slime.el Log Message: (slime-xref-mode): Summarise the most important bindings in the mode description. Date: Fri Apr 1 23:57:54 2005 Author: lgorrie Index: slime/slime.el diff -u slime/slime.el:1.477 slime/slime.el:1.478 --- slime/slime.el:1.477 Fri Apr 1 21:58:20 2005 +++ slime/slime.el Fri Apr 1 23:57:53 2005 @@ -5853,7 +5853,13 @@ "Buffer local variable in xref windows.") (define-derived-mode slime-xref-mode lisp-mode "xref" - "\\\ + "slime-xref-mode: Major mode for cross-referencing. +\\\ +The most important commands: +\\[slime-xref-quit] - Dismiss buffer. +\\[slime-show-xref] - Display referenced source and keep xref window. +\\[slime-goto-xref] - Jump to referenced source and dismiss xref window. + \\{slime-xref-mode-map}" (setq font-lock-defaults nil) (setq delayed-mode-hooks nil) From heller at common-lisp.net Sun Apr 3 23:26:54 2005 From: heller at common-lisp.net (Helmut Eller) Date: Mon, 4 Apr 2005 01:26:54 +0200 (CEST) Subject: [slime-cvs] CVS update: slime/slime.el Message-ID: <20050403232654.C853B8866C@common-lisp.net> Update of /project/slime/cvsroot/slime In directory common-lisp.net:/tmp/cvs-serv25407 Modified Files: slime.el Log Message: (slime-repl-show-maximum-output): New function. Immitate the scrolling behavior of a terminal. (slime-with-output-end-mark, slime-repl-return) (slime-repl-send-input, slime-display-output-buffer): Use it (slime-lisp-implementation-version, slime-machine-instance): New connection variables. (slime-set-connection-info): Initialize them. (find-coding-system, check-coding-system, process-coding-system): Dummy functions for non-mule-XEmacsen. Date: Mon Apr 4 01:26:51 2005 Author: heller Index: slime/slime.el diff -u slime/slime.el:1.478 slime/slime.el:1.479 --- slime/slime.el:1.478 Fri Apr 1 23:57:53 2005 +++ slime/slime.el Mon Apr 4 01:26:50 2005 @@ -1602,9 +1602,10 @@ (defun slime-run-when-idle (function) "Call FUNCTION as soon as Emacs is idle." - (run-at-time (if (featurep 'xemacs) itimer-short-interval 0) - nil - function)) + (cond ((featurep 'xemacs) + (run-at-time itimer-short-interval nil + (lambda (f) (funcall f)) function)) + (t (run-at-time 0 nil function)))) (defun slime-process-available-input () "Process all complete messages that have arrived from Lisp." @@ -1824,6 +1825,9 @@ (slime-def-connection-var slime-lisp-implementation-type nil "The implementation type of the Lisp process.") +(slime-def-connection-var slime-lisp-implementation-version nil + "The implementation type of the Lisp process.") + (slime-def-connection-var slime-lisp-implementation-type-name nil "The short name for the implementation type of the Lisp process.") @@ -1839,6 +1843,9 @@ (slime-def-connection-var slime-communication-style nil "The communication style.") +(slime-def-connection-var slime-machine-instance nil + "The name of the (remote) machine running the Lisp process.") + ;;;;; Connection setup (defvar slime-connection-counter 0 @@ -1872,13 +1879,15 @@ (defun slime-set-connection-info (connection info) "Initialize CONNECTION with INFO received from Lisp." - (destructuring-bind (pid type name features style) info + (destructuring-bind (pid type name features style version host) info (setf (slime-pid) pid (slime-lisp-implementation-type) type (slime-lisp-implementation-type-name) name (slime-connection-name) (slime-generate-connection-name name) (slime-lisp-features) features - (slime-communication-style) style)) + (slime-communication-style) style + (slime-lisp-implementation-version) version + (slime-machine-instance) host)) (setq slime-state-name "") ; FIXME (slime-hide-inferior-lisp-buffer) (slime-init-output-buffer connection) @@ -2417,9 +2426,11 @@ slime-repl-input-start-mark))) (defun slime-maybe-display-output-buffer (start end) - (when (and (not (get-buffer-window (current-buffer) t)) - (< start end)) - (display-buffer (current-buffer)))) + (when (and (< start end) + (not (get-buffer-window (current-buffer) t))) + (display-buffer (current-buffer))) + (when (eobp) + (slime-repl-show-maximum-output t))) (defun slime-flush-output () (while (accept-process-output nil 0 20))) @@ -2437,7 +2448,8 @@ (with-current-buffer (slime-output-buffer) (goto-char (point-max)) (unless (get-buffer-window (current-buffer) t) - (display-buffer (current-buffer) t)))) + (display-buffer (current-buffer) t)) + (slime-repl-show-maximum-output))) (defsetf marker-insertion-type set-marker-insertion-type) @@ -2447,22 +2459,20 @@ If point is initially at `slime-output-end' and the buffer is visible update window-point afterwards. If point is initially not at `slime-output-end, execute body inside a `save-excursion' block." - `(progn - (cond ((= (point) slime-output-end) - (let ((start (point))) - ;; XXX Assertion is currently easy to break, by typeing - ;; input while we're waiting for output - ;;(assert (<= (point) slime-repl-input-start-mark)) - , at body - (when-let (w (get-buffer-window (current-buffer) t)) - (set-window-point w (point))) - (when (= start slime-repl-input-start-mark) + `(let ((body.. (lambda () , at body)) + (updatep.. (and (eobp) (pos-visible-in-window-p)))) + (cond ((= (point) slime-output-end) + (let ((start.. (point))) + (funcall body..) + (when (= start.. slime-repl-input-start-mark) (set-marker slime-repl-input-start-mark (point))))) (t (save-excursion (goto-char slime-output-end) - ;;(assert (<= (point) slime-repl-input-start-mark)) - , at body))))) + (funcall body..)))) + (when updatep.. + (slime-repl-show-maximum-output + (> (- slime-output-end slime-output-start) 1000))))) (defun slime-output-filter (process string) (when (and (slime-connected-p) @@ -2605,8 +2615,8 @@ (setq font-lock-defaults nil) (setq mode-name "REPL") (setq slime-current-thread :repl-thread) - ;;(set (make-local-variable 'scroll-conservatively) 20) - ;;(set (make-local-variable 'scroll-margin) 0) + (set (make-local-variable 'scroll-conservatively) 20) + (set (make-local-variable 'scroll-margin) 0) (slime-setup-command-hooks) (run-hooks 'slime-repl-mode-hook)) @@ -2642,7 +2652,8 @@ (slime-repl-move-output-mark-before-prompt (current-buffer))) (t (run-at-time time nil 'slime-repl-move-output-mark-before-prompt - (current-buffer)))))))) + (current-buffer))))))) + (slime-repl-show-maximum-output)) (defun slime-repl-move-output-mark-before-prompt (buffer) (when (buffer-live-p buffer) @@ -2651,6 +2662,21 @@ (goto-char slime-repl-prompt-start-mark) (slime-mark-output-start))))) +(defun slime-repl-show-maximum-output (&optional force) + "Put the end of the buffer at the bottom of the window." + (assert (eobp)) + (let ((win (get-buffer-window (current-buffer)))) + (when (and win (or force (not (pos-visible-in-window-p)))) + (save-selected-window + (save-excursion + (select-window win) + (goto-char (point-max)) + (recenter -1)))))) + +(defun slime-buffer-visible-p (&optional buffer) + (if (get-buffer-window (or buffer (current-buffer))) + t)) + (defun slime-repl-current-input () "Return the current input as string. The input is the region from after the last prompt to the end of buffer." @@ -2790,7 +2816,11 @@ (assert (<= (point) slime-repl-input-end-mark)) (cond ((and (get-text-property (point) 'slime-repl-old-input) (< (point) slime-repl-input-start-mark)) - (slime-repl-grab-old-input end-of-input)) + (slime-repl-grab-old-input end-of-input) + (unless (pos-visible-in-window-p slime-repl-input-end-mark) + (save-excursion + (goto-char slime-repl-input-end-mark) + (recenter -1)))) (end-of-input (slime-repl-send-input)) (slime-repl-read-mode ; bad style? @@ -2808,7 +2838,9 @@ (when (< (point) slime-repl-input-start-mark) (error "No input at point.")) (goto-char slime-repl-input-end-mark) - (when newline (insert "\n")) + (when newline + (insert "\n") + (slime-repl-show-maximum-output)) (add-text-properties slime-repl-input-start-mark (point) `(slime-repl-old-input ,(incf slime-repl-old-input-counter))) @@ -8158,13 +8190,13 @@ "Lookup the argument list for FUNCTION-NAME. Confirm that EXPECTED-ARGLIST is displayed." '(("swank:start-server" - "(swank:start-server port-file &optional \\((style \\*communication-style\\*)\\|style\\)[ \n]+dont-close)") + "(swank:start-server port-file &key \\((style \\*communication-style\\*)\\|style\\)[ \n]+dont-close[ \n]+(external-format \\*coding-system\\*))") ("swank::compound-prefix-match" "(swank::compound-prefix-match prefix target)") ("swank::create-socket" "(swank::create-socket host port)") ("swank::emacs-connected" - "(swank::emacs-connected stream)") + "(swank::emacs-connected)") ("swank::compile-string-for-emacs" "(swank::compile-string-for-emacs string buffer position directory)") ("swank::connection.socket-io" @@ -8668,8 +8700,10 @@ `(unless (fboundp ',name) (defun ,name , at rest)))) +(put 'slime-defun-if-undefined 'lisp-indent-function 2) + (slime-defun-if-undefined next-single-char-property-change - (position prop &optional object limit) + (position prop &optional object limit) (let ((limit (typecase limit (null nil) (marker (marker-position limit)) @@ -8688,7 +8722,7 @@ return pos)))))) (slime-defun-if-undefined previous-single-char-property-change - (position prop &optional object limit) + (position prop &optional object limit) (let ((limit (typecase limit (null nil) (marker (marker-position limit)) @@ -8859,6 +8893,20 @@ (t (error "Not a directory: %s" file))))) +(slime-defun-if-undefined find-coding-system (coding-system) + (if (eq coding-system 'binary) + 'binary)) + +(slime-defun-if-undefined check-coding-system (coding-system) + (or (find-coding-system coding-system) + (error "No such coding system: %S" coding-system))) + +(slime-defun-if-undefined process-coding-system (process) + '(binary . binary)) + +(slime-defun-if-undefined set-process-coding-system + (process &optional decoding encoding)) + (unless (boundp 'temporary-file-directory) (defvar temporary-file-directory (file-name-as-directory @@ -8898,7 +8946,7 @@ slime-output-string slime-output-buffer slime-output-filter - slime-with-output-end-mark + slime-repl-show-maximum-output slime-process-available-input slime-dispatch-event slime-net-filter From heller at common-lisp.net Sun Apr 3 23:27:21 2005 From: heller at common-lisp.net (Helmut Eller) Date: Mon, 4 Apr 2005 01:27:21 +0200 (CEST) Subject: [slime-cvs] CVS update: slime/swank.lisp Message-ID: <20050403232721.318348866C@common-lisp.net> Update of /project/slime/cvsroot/slime In directory common-lisp.net:/tmp/cvs-serv25440 Modified Files: swank.lisp Log Message: (connection-info): Include version and hostname in the result. Date: Mon Apr 4 01:27:20 2005 Author: heller Index: slime/swank.lisp diff -u slime/swank.lisp:1.291 slime/swank.lisp:1.292 --- slime/swank.lisp:1.291 Fri Apr 1 21:55:18 2005 +++ slime/swank.lisp Mon Apr 4 01:27:20 2005 @@ -1016,13 +1016,16 @@ (defslimefun connection-info () "Return a list of the form: -\(PID IMPLEMENTATION-TYPE IMPLEMENTATION-NAME FEATURES)." +\(PID IMPLEMENTATION-TYPE IMPLEMENTATION-NAME FEATURES + COMMUNICATION-STYLE IMPLEMENTATION-VERSION MACHINE-INSTANCE)." (setq *slime-features* *features*) (list (getpid) (lisp-implementation-type) (lisp-implementation-type-name) (features-for-emacs) - (connection.communication-style *emacs-connection*))) + (connection.communication-style *emacs-connection*) + (lisp-implementation-version) + (machine-instance))) ;;;; Reading and printing From heller at common-lisp.net Sun Apr 3 23:27:42 2005 From: heller at common-lisp.net (Helmut Eller) Date: Mon, 4 Apr 2005 01:27:42 +0200 (CEST) Subject: [slime-cvs] CVS update: slime/swank-cmucl.lisp Message-ID: <20050403232742.82CF38866C@common-lisp.net> Update of /project/slime/cvsroot/slime In directory common-lisp.net:/tmp/cvs-serv25461 Modified Files: swank-cmucl.lisp Log Message: (breakpoint-values): Fixes for CMUCL-2005-03 snapshot. Date: Mon Apr 4 01:27:42 2005 Author: heller Index: slime/swank-cmucl.lisp diff -u slime/swank-cmucl.lisp:1.142 slime/swank-cmucl.lisp:1.143 --- slime/swank-cmucl.lisp:1.142 Mon Mar 21 01:58:15 2005 +++ slime/swank-cmucl.lisp Mon Apr 4 01:27:41 2005 @@ -1642,8 +1642,15 @@ (: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) + (mv-function-end-breakpoint-values sc) (list (1st sc))))))))) + +;; XXX: di::get-function-end-breakpoint-values takes 2 arguments in +;; newer versions of CMUCL (after ~March 2005). +(defun mv-function-end-breakpoint-values (sigcontext) + (let ((sym (find-symbol "FUNCTION-END-BREAKPOINT-VALUES/STANDARD" :di))) + (cond (sym (funcall sym sigcontext)) + (t (di::get-function-end-breakpoint-values sigcontext))))) (defun debug-function-returns (debug-fun) "Return the return style of DEBUG-FUN." From heller at common-lisp.net Sun Apr 3 23:28:06 2005 From: heller at common-lisp.net (Helmut Eller) Date: Mon, 4 Apr 2005 01:28:06 +0200 (CEST) Subject: [slime-cvs] CVS update: slime/doc/slime.texi Message-ID: <20050403232806.D50188866C@common-lisp.net> Update of /project/slime/cvsroot/slime/doc In directory common-lisp.net:/tmp/cvs-serv25481 Modified Files: slime.texi Log Message: Fix spelling errors. Date: Mon Apr 4 01:28:06 2005 Author: heller Index: slime/doc/slime.texi diff -u slime/doc/slime.texi:1.35 slime/doc/slime.texi:1.36 --- slime/doc/slime.texi:1.35 Thu Mar 31 22:39:19 2005 +++ slime/doc/slime.texi Mon Apr 4 01:28:06 2005 @@ -46,7 +46,7 @@ @end macro @set EDITION 1.2 - at set UPDATED @code{$Date: 2005/03/31 20:39:19 $} + at set UPDATED @code{$Date: 2005/04/03 23:28:06 $} @titlepage @title SLIME User Manual @@ -1271,11 +1271,14 @@ @item slime-net-coding-system If you want to transmit Unicode characters between Emacs and the Lisp system, you should customize this variable. E.g., if you use SBCL, you -can set @code{slime-net-coding-system} to @code{utf-8-unix}. To -actually display a Unicode character you also need apropriate fonts, -otherwise the character will be rendered as a hollow box. If you are +can set: + at example +(setq slime-net-coding-system 'utf-8-unix) + at end example +To actually display Unicode characters you also need appropriate fonts, +otherwise the characters will be rendered as hollow boxes. If you are using Allegro CL and GNU Emacs, you can also use @code{emacs-mule-unix} -as coding system. GNU Emacs has often nicer fonts for the later +as coding system. GNU Emacs has often nicer fonts for the latter encoding. @end table @@ -1398,13 +1401,12 @@ multithreaded and callback-driven applications. @item SWANK:*SLDB-PRINTER-BINDINGS* - at item SWANK:*MACROEXPAND-PRINTER-BINDINGS* - at item SWANK:*SWANK-PPRINT-BINDINGS* + at itemx SWANK:*MACROEXPAND-PRINTER-BINDINGS* + at itemx SWANK:*SWANK-PPRINT-BINDINGS* These variables can be used to customize the printer in various situations. The values of the variables are association lists of printer variable names with the corresponding value. E.g., to enable the pretty printer for formatting backtraces in @SLDB{}, you can use: - @example (push '(*print-pretty* . t) swank:*sldb-printer-bindings*). @end example @@ -1464,4 +1466,3 @@ Martin's initial work on the LispWorks backend! @bye - From heller at common-lisp.net Sun Apr 3 23:28:21 2005 From: heller at common-lisp.net (Helmut Eller) Date: Mon, 4 Apr 2005 01:28:21 +0200 (CEST) Subject: [slime-cvs] CVS update: slime/ChangeLog Message-ID: <20050403232821.A21798866C@common-lisp.net> Update of /project/slime/cvsroot/slime In directory common-lisp.net:/tmp/cvs-serv25501 Modified Files: ChangeLog Log Message: *** empty log message *** Date: Mon Apr 4 01:28:21 2005 Author: heller Index: slime/ChangeLog diff -u slime/ChangeLog:1.657 slime/ChangeLog:1.658 --- slime/ChangeLog:1.657 Fri Apr 1 23:57:42 2005 +++ slime/ChangeLog Mon Apr 4 01:28:20 2005 @@ -1,3 +1,27 @@ +2005-04-04 James McIlree + + * slime.el (find-coding-system, check-coding-system) + (process-coding-system, set-process-coding-system): Dummy + functions for no-mule-XEmacsen. + +2005-04-04 Helmut Eller + + * slime.el (slime-repl-show-maximum-output): New + function. Immitate the scrolling behavior of a terminal. + (slime-with-output-end-mark, slime-repl-return) + (slime-repl-send-input, slime-display-output-buffer): Use it + (slime-lisp-implementation-version, slime-machine-instance): New + connection variables. Suggested by Eduardo Mu?oz. + (slime-set-connection-info): Initialize them. + + * swank.lisp (connection-info): Include version and hostname in + the result. + + * swank-cmucl.lisp (breakpoint-values): Fixes for CMUCL-2005-03 + snapshot. + + * doc/slime.texi: Fix spelling errors. + 2005-04-01 Helmut Eller * slime.el (sldb-get-buffer): Initialize the buffer local From heller at common-lisp.net Mon Apr 4 06:15:21 2005 From: heller at common-lisp.net (Helmut Eller) Date: Mon, 4 Apr 2005 08:15:21 +0200 (CEST) Subject: [slime-cvs] CVS update: slime/cl-indent.el Message-ID: <20050404061521.68A0F88704@common-lisp.net> Update of /project/slime/cvsroot/slime In directory common-lisp.net:/tmp/cvs-serv16491 Removed Files: cl-indent.el Log Message: Remove the file. Let the Emacs developers maintain it. Date: Mon Apr 4 08:15:10 2005 Author: heller From heller at common-lisp.net Mon Apr 4 06:16:24 2005 From: heller at common-lisp.net (Helmut Eller) Date: Mon, 4 Apr 2005 08:16:24 +0200 (CEST) Subject: [slime-cvs] CVS update: slime/ChangeLog Message-ID: <20050404061624.64A1888704@common-lisp.net> Update of /project/slime/cvsroot/slime In directory common-lisp.net:/tmp/cvs-serv17312 Modified Files: ChangeLog Log Message: *** empty log message *** Date: Mon Apr 4 08:16:23 2005 Author: heller Index: slime/ChangeLog diff -u slime/ChangeLog:1.658 slime/ChangeLog:1.659 --- slime/ChangeLog:1.658 Mon Apr 4 01:28:20 2005 +++ slime/ChangeLog Mon Apr 4 08:16:23 2005 @@ -22,6 +22,9 @@ * doc/slime.texi: Fix spelling errors. + * cl-indent.el: Remove the file. Let the Emacs developers + maintain it. + 2005-04-01 Helmut Eller * slime.el (sldb-get-buffer): Initialize the buffer local From mbaringer at common-lisp.net Tue Apr 5 13:41:24 2005 From: mbaringer at common-lisp.net (Marco Baringer) Date: Tue, 5 Apr 2005 15:41:24 +0200 (CEST) Subject: [slime-cvs] CVS update: /slime/ChangeLog Message-ID: <20050405134124.3CB0D88665@common-lisp.net> Update of /project/slime/cvsroot//slime In directory common-lisp.net:/tmp/cvs-serv32500 Modified Files: ChangeLog Log Message: Date: Tue Apr 5 15:41:23 2005 Author: mbaringer From mbaringer at common-lisp.net Tue Apr 5 13:45:33 2005 From: mbaringer at common-lisp.net (Marco Baringer) Date: Tue, 5 Apr 2005 15:45:33 +0200 (CEST) Subject: [slime-cvs] CVS update: /slime/swank-lispworks.lisp Message-ID: <20050405134533.9EA7188665@common-lisp.net> Update of /project/slime/cvsroot//slime In directory common-lisp.net:/tmp/cvs-serv636 Modified Files: swank-lispworks.lisp Log Message: (find-top-frame): If we can't find an invoke-debugger frame we take any old frame at the top. Date: Tue Apr 5 15:45:33 2005 Author: mbaringer From heller at common-lisp.net Thu Apr 7 06:54:48 2005 From: heller at common-lisp.net (Helmut Eller) Date: Thu, 7 Apr 2005 08:54:48 +0200 (CEST) Subject: [slime-cvs] CVS update: slime/slime.el Message-ID: <20050407065448.7F9A118C6C5@common-lisp.net> Update of /project/slime/cvsroot/slime In directory common-lisp.net:/tmp/cvs-serv17653 Modified Files: slime.el Log Message: (slime-net-coding-system): More fixes for non-mule-XEmacsen. Date: Thu Apr 7 08:54:42 2005 Author: heller Index: slime/slime.el diff -u slime/slime.el:1.479 slime/slime.el:1.480 --- slime/slime.el:1.479 Mon Apr 4 01:26:50 2005 +++ slime/slime.el Thu Apr 7 08:54:42 2005 @@ -63,7 +63,6 @@ (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.") @@ -1490,7 +1489,9 @@ The functions are called with the process as their argument.") (defvar slime-net-coding-system - (find-if (if (featurep 'xemacs) #'find-coding-system #'coding-system-p) + (find-if (cond ((fboundp 'coding-system-p) #'coding-system-p) + ((fboundp 'find-coding-system) #'find-coding-system) + (t (lambda (x) (eq x 'binary)))) '(iso-latin-1-unix iso-8859-1-unix binary)) "*Coding system used for network connections. See also `slime-net-valid-coding-systems'.") @@ -7483,6 +7484,7 @@ :has-echildren t)))) (defun slime-call-with-browser-setup (buffer package title fn) + (require 'tree-widget) (switch-to-buffer buffer) (kill-all-local-variables) (setq slime-buffer-package package) @@ -8893,12 +8895,8 @@ (t (error "Not a directory: %s" file))))) -(slime-defun-if-undefined find-coding-system (coding-system) - (if (eq coding-system 'binary) - 'binary)) - (slime-defun-if-undefined check-coding-system (coding-system) - (or (find-coding-system coding-system) + (or (eq coding-system 'binary) (error "No such coding system: %S" coding-system))) (slime-defun-if-undefined process-coding-system (process) From heller at common-lisp.net Thu Apr 7 06:55:09 2005 From: heller at common-lisp.net (Helmut Eller) Date: Thu, 7 Apr 2005 08:55:09 +0200 (CEST) Subject: [slime-cvs] CVS update: slime/ChangeLog Message-ID: <20050407065509.ECB6318C6C5@common-lisp.net> Update of /project/slime/cvsroot/slime In directory common-lisp.net:/tmp/cvs-serv17689 Modified Files: ChangeLog Log Message: *** empty log message *** Date: Thu Apr 7 08:55:09 2005 Author: heller Index: slime/ChangeLog diff -u slime/ChangeLog:1.660 slime/ChangeLog:1.661 --- slime/ChangeLog:1.660 Tue Apr 5 15:41:23 2005 +++ slime/ChangeLog Thu Apr 7 08:55:09 2005 @@ -1,3 +1,8 @@ +2005-04-07 Helmut Eller + + * slime.el (slime-net-coding-system): More fixes for + non-mule-XEmacsen. + 2005-04-05 Juergen Gmeiner * swank-lisworks.lisp (find-top-frame): If we can't find an From heller at common-lisp.net Thu Apr 7 10:00:14 2005 From: heller at common-lisp.net (Helmut Eller) Date: Thu, 7 Apr 2005 12:00:14 +0200 (CEST) Subject: [slime-cvs] CVS update: slime/slime.el Message-ID: <20050407100014.4A508880E1@common-lisp.net> Update of /project/slime/cvsroot/slime In directory common-lisp.net:/tmp/cvs-serv29119 Modified Files: slime.el Log Message: (slime-net-coding-system): Even more fixes to make it with mule-XEmacs. Date: Thu Apr 7 12:00:13 2005 Author: heller Index: slime/slime.el diff -u slime/slime.el:1.480 slime/slime.el:1.481 --- slime/slime.el:1.480 Thu Apr 7 08:54:42 2005 +++ slime/slime.el Thu Apr 7 12:00:12 2005 @@ -1489,9 +1489,11 @@ The functions are called with the process as their argument.") (defvar slime-net-coding-system - (find-if (cond ((fboundp 'coding-system-p) #'coding-system-p) - ((fboundp 'find-coding-system) #'find-coding-system) - (t (lambda (x) (eq x 'binary)))) + (find-if (cond ((featurep 'xemacs) + (if (fboundp 'find-coding-system) + #'find-coding-system + (lambda (x) (eq x 'binary)))) + (t #'coding-system-p)) '(iso-latin-1-unix iso-8859-1-unix binary)) "*Coding system used for network connections. See also `slime-net-valid-coding-systems'.") From heller at common-lisp.net Thu Apr 7 10:00:41 2005 From: heller at common-lisp.net (Helmut Eller) Date: Thu, 7 Apr 2005 12:00:41 +0200 (CEST) Subject: [slime-cvs] CVS update: slime/ChangeLog Message-ID: <20050407100041.20C9118C6C5@common-lisp.net> Update of /project/slime/cvsroot/slime In directory common-lisp.net:/tmp/cvs-serv29457 Modified Files: ChangeLog Log Message: *** empty log message *** Date: Thu Apr 7 12:00:40 2005 Author: heller Index: slime/ChangeLog diff -u slime/ChangeLog:1.661 slime/ChangeLog:1.662 --- slime/ChangeLog:1.661 Thu Apr 7 08:55:09 2005 +++ slime/ChangeLog Thu Apr 7 12:00:40 2005 @@ -2,7 +2,9 @@ * slime.el (slime-net-coding-system): More fixes for non-mule-XEmacsen. - + (slime-net-coding-system): Even more fixes to make it for + mule-XEmacs. + 2005-04-05 Juergen Gmeiner * swank-lisworks.lisp (find-top-frame): If we can't find an From heller at common-lisp.net Sat Apr 9 07:06:00 2005 From: heller at common-lisp.net (Helmut Eller) Date: Sat, 9 Apr 2005 09:06:00 +0200 (CEST) Subject: [slime-cvs] CVS update: slime/slime.el Message-ID: <20050409070600.9343418C6F8@common-lisp.net> Update of /project/slime/cvsroot/slime In directory common-lisp.net:/tmp/cvs-serv24098 Modified Files: slime.el Log Message: (sldb-get-buffer): Create a fresh buffer if there's no buffer for the connection (and don't reuse an existing buffer even if it has a matching name). (slime-buffer-visible-p, slime-ir1-expand): Delete unused functions. Mark some others as unused, but leave them there because they are potentially useful. Date: Sat Apr 9 09:05:56 2005 Author: heller Index: slime/slime.el diff -u slime/slime.el:1.481 slime/slime.el:1.482 --- slime/slime.el:1.481 Thu Apr 7 12:00:12 2005 +++ slime/slime.el Sat Apr 9 09:05:54 2005 @@ -2676,10 +2676,6 @@ (goto-char (point-max)) (recenter -1)))))) -(defun slime-buffer-visible-p (&optional buffer) - (if (get-buffer-window (or buffer (current-buffer))) - t)) - (defun slime-repl-current-input () "Return the current input as string. The input is the region from after the last prompt to the end of buffer." @@ -3606,6 +3602,7 @@ (setf (getf new-note :references) new-references) new-note))) +;; XXX: unused function (defun slime-intersperse (element list) "Intersperse ELEMENT between each element of LIST." (if (null list) @@ -3987,6 +3984,7 @@ sev1 sev2))) +;; XXX: unused function (defun slime-visit-source-path (source-path) "Visit a full source path including the top-level form." (goto-char (point-min)) @@ -6140,11 +6138,6 @@ (interactive) (slime-eval-macroexpand 'swank:swank-macroexpand-all)) -(defun slime-ir1-expand () - "Display the ir1 form of the sexp at point." - (interactive) - (slime-eval-macroexpand 'swank:print-ir1-converted-blocks)) - ;;;; Subprocess control @@ -6414,7 +6407,7 @@ (let ((connection (or connection (slime-connection)))) (or (sldb-find-buffer thread connection) (let ((name (format "*sldb %s/%s*" (slime-connection-name) thread))) - (with-current-buffer (get-buffer-create name) + (with-current-buffer (generate-new-buffer name) (setq slime-buffer-connection connection slime-current-thread thread) (current-buffer)))))) @@ -7141,6 +7134,7 @@ (rassoc name slime-registered-lisp-implementations)))) (if cons (cdr cons) name))) +;; XXX: unused function (defun slime-find-lisp-implementation-name (command) (cdr (rassoc command slime-registered-lisp-implementations))) @@ -8117,6 +8111,7 @@ (defun slime-sync-to-top-level (timeout) (slime-wait-condition "top-level" #'slime-at-top-level-p timeout)) +;; XXX: unused function (defun slime-check-sldb-level (expected) (let ((sldb-level (when-let (sldb (sldb-get-default-buffer)) (with-current-buffer sldb @@ -8556,6 +8551,7 @@ (match-string 1 n) default))) +;; XXX: unused function (defun slime-cl-symbol-external-ref-p (symbol) "Does SYMBOL refer to an external symbol? FOO:BAR is an external reference. @@ -8564,6 +8560,7 @@ (and (string-match ":" name) (not (string-match "::" name))))) +;; XXX: unused function (defun slime-qualify-cl-symbol (symbol-or-name) "Like `slime-qualify-cl-symbol-name', but interns the result." (intern (slime-qualify-cl-symbol-name symbol-or-name))) From heller at common-lisp.net Sat Apr 9 07:06:35 2005 From: heller at common-lisp.net (Helmut Eller) Date: Sat, 9 Apr 2005 09:06:35 +0200 (CEST) Subject: [slime-cvs] CVS update: slime/swank-abcl.lisp Message-ID: <20050409070635.94FDB18C6F8@common-lisp.net> Update of /project/slime/cvsroot/slime In directory common-lisp.net:/tmp/cvs-serv24146 Modified Files: swank-abcl.lisp Log Message: (print-frame): Trim whitespace to make the backtrace look a bit terser. Date: Sat Apr 9 09:06:35 2005 Author: heller Index: slime/swank-abcl.lisp diff -u slime/swank-abcl.lisp:1.24 slime/swank-abcl.lisp:1.25 --- slime/swank-abcl.lisp:1.24 Thu Feb 10 20:22:43 2005 +++ slime/swank-abcl.lisp Sat Apr 9 09:06:35 2005 @@ -15,7 +15,8 @@ (require :collect) ;just so that it doesn't spoil the flying letters (require :pprint)) -(defun sys::break (&optional (format-control "BREAK called") &rest format-arguments) +(defun sys::break (&optional (format-control "BREAK called") + &rest format-arguments) (let ((*saved-backtrace* (sys::backtrace-as-list))) (with-simple-restart (continue "Return from BREAK.") (invoke-debugger @@ -201,15 +202,13 @@ (subseq (ext:backtrace-as-list) start end))) (defimplementation print-frame (frame stream) - (pprint frame stream)) + (write-string (string-trim '(#\space #\newline) + (prin1-to-string frame)) + stream)) -#+nil (defimplementation frame-locals (index) - (let ((frame (nth-frame index))) - (loop for i from 0 below (debugger:frame-number-vars frame) - collect (list :name (debugger:frame-var-name frame i) - :id 0 - :value (debugger:frame-var-value frame i))))) + `((list :name "??" :id 0 :value "??"))) + (defimplementation frame-catch-tags (index) (declare (ignore index)) From heller at common-lisp.net Sat Apr 9 07:07:01 2005 From: heller at common-lisp.net (Helmut Eller) Date: Sat, 9 Apr 2005 09:07:01 +0200 (CEST) Subject: [slime-cvs] CVS update: slime/swank-sbcl.lisp Message-ID: <20050409070701.24A2C18C6F8@common-lisp.net> Update of /project/slime/cvsroot/slime In directory common-lisp.net:/tmp/cvs-serv24166 Modified Files: swank-sbcl.lisp Log Message: Add a few comments. Date: Sat Apr 9 09:07:00 2005 Author: heller Index: slime/swank-sbcl.lisp diff -u slime/swank-sbcl.lisp:1.128 slime/swank-sbcl.lisp:1.129 --- slime/swank-sbcl.lisp:1.128 Mon Mar 21 18:40:40 2005 +++ slime/swank-sbcl.lisp Sat Apr 9 09:07:00 2005 @@ -14,9 +14,7 @@ (eval-when (:compile-toplevel :load-toplevel :execute) (require 'sb-bsd-sockets) (require 'sb-introspect) - (require 'sb-posix) - ) - + (require 'sb-posix)) (in-package :swank-backend) (declaim (optimize (debug 2))) @@ -152,6 +150,12 @@ ;;;; Support for SBCL syntax +;;; SBCL's source code is riddled with #! reader macros. Also symbols +;;; containing `!' have special meaning. We have to work long and +;;; hard to be able to read the source. To deal with #! reader +;;; macros, we use a special readtable. The special symbols are +;;; converted by a condition handler. + (defun feature-in-list-p (feature list) (etypecase feature (symbol (member feature list :test #'eq)) @@ -450,12 +454,15 @@ (list (list `(define-compiler-macro ,name) (loc (compiler-macro-function name) name))))))) -(defun safe-function-source-location (fun name) - (if *debug-definition-finding* - (function-source-location fun name) - (handler-case (function-source-location fun name) - (error (e) - (list :error (format nil "Error: ~A" e)))))) +;;;; function -> soucre location translation + +;;; Here we try to find the source locations for function objects. We +;;; have to special case functions which were compiled with C-c C-c. +;;; For the other functions we used the toplevel form number as +;;; returned by the sb-introspect package to find the offset in the +;;; source file. (If the function has debug-blocks, we should search +;;; the position of the first code-location; for some reason, that +;;; doesn't seem to work.) (defun function-source-location (function &optional name) "Try to find the canonical source location of FUNCTION." @@ -464,6 +471,13 @@ (find-temp-function-source-location function) (find-function-source-location function))) +(defun safe-function-source-location (fun name) + (if *debug-definition-finding* + (function-source-location fun name) + (handler-case (function-source-location fun name) + (error (e) + (list :error (format nil "Error: ~A" e)))))) + (defun find-function-source-location (function) (cond #+(or) ;; doesn't work for unknown reasons ((function-has-start-location-p function) @@ -516,7 +530,7 @@ (defun find-temp-function-source-location (function) (let ((info (function-debug-source-info function))) - (with-struct (sb-introspect::definition-source- + (with-struct (sb-introspect::definition-source- form-path character-offset) (sb-introspect:find-definition-source function) (destructuring-bind (&key emacs-buffer emacs-position emacs-string) info @@ -696,6 +710,12 @@ ;;;; Code-location -> source-location translation +;;; If debug-block info is avaibale, we determine the file position of +;;; the source-path for a code-location. If the code was compiled +;;; with C-c C-c, we have to search the position in the source string. +;;; If there's no debug-block info, we return the (less precise) +;;; source-location of the corresponding function. + (defun code-location-source-location (code-location) (let ((dsource (sb-di:code-location-debug-source code-location))) (ecase (sb-di:debug-source-from dsource) @@ -782,7 +802,7 @@ (multiple-value-bind (tlf pos-map) (read-source-form tlf-number stream) (let* ((path-table (sb-di::form-number-translations tlf 0)) (path (cond ((<= (length path-table) form-number) - (warn "inconsistend form-number-translations") + (warn "inconsistent form-number-translations") (list 0)) (t (reverse (cdr (aref path-table form-number))))))) From heller at common-lisp.net Sat Apr 9 07:07:47 2005 From: heller at common-lisp.net (Helmut Eller) Date: Sat, 9 Apr 2005 09:07:47 +0200 (CEST) Subject: [slime-cvs] CVS update: slime/swank.lisp Message-ID: <20050409070747.4E8A118C6F8@common-lisp.net> Update of /project/slime/cvsroot/slime In directory common-lisp.net:/tmp/cvs-serv24186 Modified Files: swank.lisp Log Message: (with-io-redirection, with-connection, with-buffer-syntax): Implement macros with a `call-with' functions to avoid some code bloat. (call-with-connection, maybe-call-with-io-redirection) (call-with-buffer-syntax): New functions. (interactive-eval): Use from-string instead of read-from-string to avoid problems whit *read-suppress*. Date: Sat Apr 9 09:07:46 2005 Author: heller Index: slime/swank.lisp diff -u slime/swank.lisp:1.292 slime/swank.lisp:1.293 --- slime/swank.lisp:1.292 Mon Apr 4 01:27:20 2005 +++ slime/swank.lisp Sat Apr 9 09:07:46 2005 @@ -78,6 +78,10 @@ (defvar *swank-debug-p* t "When true, print extra debugging information.") +(defvar *redirect-io* t + "When non-nil redirect Lisp standard I/O to Emacs. +Redirection is done while Lisp is processing a request for Emacs.") + (defvar *sldb-printer-bindings* `((*print-pretty* . nil) (*print-level* . 4) @@ -258,17 +262,23 @@ (defmacro with-io-redirection ((connection) &body body) "Execute BODY I/O redirection to CONNECTION. If *REDIRECT-IO* is true then all standard I/O streams are redirected." - `(if *redirect-io* - (call-with-redirected-io ,connection (lambda () , at body)) - (progn , at body))) + `(maybe-call-with-io-redirection ,connection (lambda () , at body))) +(defun maybe-call-with-io-redirection (connection fun) + (if *redirect-io* + (call-with-redirected-io connection fun) + (funcall fun))) + (defmacro with-connection ((connection) &body body) "Execute BODY in the context of CONNECTION." - `(let ((*emacs-connection* ,connection)) - (catch 'slime-toplevel - (with-io-redirection (*emacs-connection*) - (let ((*debugger-hook* #'swank-debugger-hook)) - , at body))))) + `(call-with-connection ,connection (lambda () , at body))) + +(defun call-with-connection (connection fun) + (let ((*emacs-connection* connection)) + (catch 'slime-toplevel + (with-io-redirection (*emacs-connection*) + (let ((*debugger-hook* #'swank-debugger-hook)) + (funcall fun)))))) (defmacro without-interrupts (&body body) `(call-without-interrupts (lambda () , at body))) @@ -317,10 +327,6 @@ ;;;; TCP Server -(defparameter *redirect-io* t - "When non-nil redirect Lisp standard I/O to Emacs. -Redirection is done while Lisp is processing a request for Emacs.") - (defvar *use-dedicated-output-stream* t) (defvar *communication-style* (preferred-communication-style)) @@ -1052,13 +1058,16 @@ This should be used for code that is conceptionally executed in an Emacs buffer." (destructuring-bind () _ - `(let ((*package* *buffer-package*)) - ;; Don't shadow *readtable* unnecessarily because that prevents - ;; the user from assigning to it. - (if (eq *readtable* *buffer-readtable*) - (call-with-syntax-hooks (lambda () , at body)) - (let ((*readtable* *buffer-readtable*)) - (call-with-syntax-hooks (lambda () , at body))))))) + `(call-with-buffer-syntax (lambda () , at body)))) + +(defun call-with-buffer-syntax (fun) + (let ((*package* *buffer-package*)) + ;; Don't shadow *readtable* unnecessarily because that prevents + ;; the user from assigning to it. + (if (eq *readtable* *buffer-readtable*) + (call-with-syntax-hooks fun) + (let ((*readtable* *buffer-readtable*)) + (call-with-syntax-hooks fun))))) (defun from-string (string) "Read string in the *BUFFER-PACKAGE*" @@ -1629,8 +1638,8 @@ (let ((*buffer-package* (guess-buffer-package buffer-package)) (*buffer-readtable* (guess-buffer-readtable buffer-package)) (*pending-continuations* (cons id *pending-continuations*))) - (assert (packagep *buffer-package*)) - (assert (readtablep *buffer-readtable*)) + (check-type *buffer-package* package) + (check-type *buffer-readtable* readtable) (setq result (eval form)) (force-output) (run-hook *pre-reply-hook*) @@ -1651,7 +1660,7 @@ (defslimefun interactive-eval (string) (with-buffer-syntax () - (let ((values (multiple-value-list (eval (read-from-string string))))) + (let ((values (multiple-value-list (eval (from-string string))))) (fresh-line) (force-output) (format-values-for-echo-area values)))) @@ -1660,7 +1669,7 @@ (with-buffer-syntax () (let* ((s (make-string-output-stream)) (*standard-output* s) - (values (multiple-value-list (eval (read-from-string string))))) + (values (multiple-value-list (eval (from-string string))))) (list (get-output-stream-string s) (format nil "~{~S~^~%~}" values))))) From heller at common-lisp.net Sat Apr 9 07:08:22 2005 From: heller at common-lisp.net (Helmut Eller) Date: Sat, 9 Apr 2005 09:08:22 +0200 (CEST) Subject: [slime-cvs] CVS update: slime/ChangeLog Message-ID: <20050409070822.9777918C6F8@common-lisp.net> Update of /project/slime/cvsroot/slime In directory common-lisp.net:/tmp/cvs-serv24206 Modified Files: ChangeLog Log Message: *** empty log message *** Date: Sat Apr 9 09:08:22 2005 Author: heller Index: slime/ChangeLog diff -u slime/ChangeLog:1.662 slime/ChangeLog:1.663 --- slime/ChangeLog:1.662 Thu Apr 7 12:00:40 2005 +++ slime/ChangeLog Sat Apr 9 09:08:21 2005 @@ -1,3 +1,25 @@ +2005-04-09 Helmut Eller + + * slime.el (sldb-get-buffer): Create a fresh buffer if there's no + buffer for the connection (and don't reuse an existing buffer even + if it has a matching name). + (slime-buffer-visible-p, slime-ir1-expand): Delete unused + functions. Mark some others as unused, but leave them there + because they are potentially useful. + + * swank.lisp (with-io-redirection, with-connection) + (with-buffer-syntax): Implement macros with a `call-with' + functions to avoid some code bloat. + (call-with-connection, maybe-call-with-io-redirection) + (call-with-buffer-syntax): New functions. + (interactive-eval): Use from-string instead of read-from-string to + avoid problems whit *read-suppress*. + + * swank-sbcl.lisp: Add a few comments. + + * swank-abcl.lisp (print-frame): Trim whitespace to make the + backtrace look a bit terser. + 2005-04-07 Helmut Eller * slime.el (slime-net-coding-system): More fixes for From heller at common-lisp.net Thu Apr 14 15:40:09 2005 From: heller at common-lisp.net (Helmut Eller) Date: Thu, 14 Apr 2005 17:40:09 +0200 (CEST) Subject: [slime-cvs] CVS update: slime/slime.el Message-ID: <20050414154009.BA09D18C6F5@common-lisp.net> Update of /project/slime/cvsroot/slime In directory common-lisp.net:/tmp/cvs-serv7296 Modified Files: slime.el Log Message: (slime-selector): Discard input after sleeping. Date: Thu Apr 14 17:40:09 2005 Author: heller Index: slime/slime.el diff -u slime/slime.el:1.482 slime/slime.el:1.483 --- slime/slime.el:1.482 Sat Apr 9 09:05:54 2005 +++ slime/slime.el Thu Apr 14 17:40:08 2005 @@ -5936,6 +5936,7 @@ (setq slime-buffer-package package) (slime-set-truncate-lines)) +;; XXX: unused function (defun slime-display-xref-buffer () "Display the XREF results buffer in a window and select it." (let* ((buffer (slime-xref-buffer)) @@ -7548,6 +7549,7 @@ (message "No method for character: ?\\%c" ch) (ding) (sleep-for 1) + (discard-input) (slime-selector)) (t (funcall (third method)))))) From heller at common-lisp.net Thu Apr 14 15:41:19 2005 From: heller at common-lisp.net (Helmut Eller) Date: Thu, 14 Apr 2005 17:41:19 +0200 (CEST) Subject: [slime-cvs] CVS update: slime/ChangeLog Message-ID: <20050414154119.878A918C6F5@common-lisp.net> Update of /project/slime/cvsroot/slime In directory common-lisp.net:/tmp/cvs-serv7338 Modified Files: ChangeLog Log Message: *** empty log message *** Date: Thu Apr 14 17:41:18 2005 Author: heller Index: slime/ChangeLog diff -u slime/ChangeLog:1.663 slime/ChangeLog:1.664 --- slime/ChangeLog:1.663 Sat Apr 9 09:08:21 2005 +++ slime/ChangeLog Thu Apr 14 17:41:17 2005 @@ -1,3 +1,7 @@ +2005-04-14 Helmut Eller + + * slime.el (slime-selector): Discard input after sleeping. + 2005-04-09 Helmut Eller * slime.el (sldb-get-buffer): Create a fresh buffer if there's no @@ -8,8 +12,8 @@ because they are potentially useful. * swank.lisp (with-io-redirection, with-connection) - (with-buffer-syntax): Implement macros with a `call-with' - functions to avoid some code bloat. + (with-buffer-syntax): Implement macros with `call-with' functions + to avoid some code bloat. (call-with-connection, maybe-call-with-io-redirection) (call-with-buffer-syntax): New functions. (interactive-eval): Use from-string instead of read-from-string to From pseibel at common-lisp.net Mon Apr 18 04:42:51 2005 From: pseibel at common-lisp.net (Peter Seibel) Date: Mon, 18 Apr 2005 06:42:51 +0200 (CEST) Subject: [slime-cvs] CVS update: slime/swank-loader.lisp Message-ID: <20050418044251.9D10118C6F8@common-lisp.net> Update of /project/slime/cvsroot/slime In directory common-lisp.net:/tmp/cvs-serv3546 Modified Files: swank-loader.lisp Log Message: Added GCL and ECL features to swank-loader.lisp Date: Mon Apr 18 06:42:50 2005 Author: pseibel Index: slime/swank-loader.lisp diff -u slime/swank-loader.lisp:1.46 slime/swank-loader.lisp:1.47 --- slime/swank-loader.lisp:1.46 Mon Mar 21 00:11:50 2005 +++ slime/swank-loader.lisp Mon Apr 18 06:42:50 2005 @@ -36,7 +36,7 @@ ))) (defparameter *implementation-features* - '(:allegro :lispworks :sbcl :openmcl :cmu :clisp :ccl :corman :armedbear)) + '(:allegro :lispworks :sbcl :openmcl :cmu :clisp :ccl :corman :armedbear :gcl :ecl)) (defparameter *os-features* '(:macosx :linux :windows :mswindows :win32 :solaris :darwin :sunos :unix)) @@ -47,6 +47,8 @@ (defun lisp-version-string () #+cmu (substitute #\- #\/ (lisp-implementation-version)) #+sbcl (lisp-implementation-version) + #+ecl (lisp-implementation-version) + #+gcl (let ((s (lisp-implementation-version))) (subseq s 4)) #+openmcl (format nil "~d.~d" ccl::*openmcl-major-version* ccl::*openmcl-minor-version*) From pseibel at common-lisp.net Mon Apr 18 04:45:05 2005 From: pseibel at common-lisp.net (Peter Seibel) Date: Mon, 18 Apr 2005 06:45:05 +0200 (CEST) Subject: [slime-cvs] CVS update: slime/ChangeLog Message-ID: <20050418044505.E77B818C6F8@common-lisp.net> Update of /project/slime/cvsroot/slime In directory common-lisp.net:/tmp/cvs-serv3582 Modified Files: ChangeLog Log Message: ChangeLog entries to go with last change. Date: Mon Apr 18 06:45:04 2005 Author: pseibel Index: slime/ChangeLog diff -u slime/ChangeLog:1.664 slime/ChangeLog:1.665 --- slime/ChangeLog:1.664 Thu Apr 14 17:41:17 2005 +++ slime/ChangeLog Mon Apr 18 06:45:04 2005 @@ -1,3 +1,10 @@ +2005-04-17 Peter Seibel + + * swank-loader.lisp (*implementation-features*): Added features + for GCL and ECL ... + (lisp-version-string): ... and code to compute version + string. (Supplied by someone who's email I've misplaced.) + 2005-04-14 Helmut Eller * slime.el (slime-selector): Discard input after sleeping. From heller at common-lisp.net Mon Apr 18 18:58:13 2005 From: heller at common-lisp.net (Helmut Eller) Date: Mon, 18 Apr 2005 20:58:13 +0200 (CEST) Subject: [slime-cvs] CVS update: slime/doc/slime.texi Message-ID: <20050418185813.64ED288030@common-lisp.net> Update of /project/slime/cvsroot/slime/doc In directory common-lisp.net:/tmp/cvs-serv22192 Modified Files: slime.texi Log Message: Update version numbers for SBCL and ACL. Date: Mon Apr 18 20:58:12 2005 Author: heller Index: slime/doc/slime.texi diff -u slime/doc/slime.texi:1.36 slime/doc/slime.texi:1.37 --- slime/doc/slime.texi:1.36 Mon Apr 4 01:28:06 2005 +++ slime/doc/slime.texi Mon Apr 18 20:58:12 2005 @@ -46,7 +46,7 @@ @end macro @set EDITION 1.2 - at set UPDATED @code{$Date: 2005/04/03 23:28:06 $} + at set UPDATED @code{$Date: 2005/04/18 18:58:12 $} @titlepage @title SLIME User Manual @@ -214,13 +214,14 @@ @item CMU Common Lisp (@acronym{CMUCL}), 18e or newer @item -Steel Bank Common Lisp (@acronym{SBCL}), from version 0.8.15 to 0.8.20 +Steel Bank Common Lisp (@acronym{SBCL}), from version 0.8.15 to 0.8.21 +(newer versions may or may not work) @item OpenMCL, version 0.14.3 @item LispWorks, version 4.3 or newer @item -Allegro Common Lisp (@acronym{ACL}), version 4.3 or newer +Allegro Common Lisp (@acronym{ACL}), version 6 or newer @item @acronym{CLISP}, version 2.33.2 or newer @item From heller at common-lisp.net Mon Apr 18 18:59:49 2005 From: heller at common-lisp.net (Helmut Eller) Date: Mon, 18 Apr 2005 20:59:49 +0200 (CEST) Subject: [slime-cvs] CVS update: slime/mkdist.sh Message-ID: <20050418185949.BEA9788030@common-lisp.net> Update of /project/slime/cvsroot/slime In directory common-lisp.net:/tmp/cvs-serv22236 Modified Files: mkdist.sh Log Message: update version number. Date: Mon Apr 18 20:59:49 2005 Author: heller Index: slime/mkdist.sh diff -u slime/mkdist.sh:1.5 slime/mkdist.sh:1.6 --- slime/mkdist.sh:1.5 Fri Sep 3 23:20:00 2004 +++ slime/mkdist.sh Mon Apr 18 20:59:49 2005 @@ -1,5 +1,5 @@ #!/bin/sh -version="1.0" +version="1.2" dist="slime-$version" if [ -d $dist ]; then rm -rf $dist; fi From heller at common-lisp.net Mon Apr 18 19:23:41 2005 From: heller at common-lisp.net (Helmut Eller) Date: Mon, 18 Apr 2005 21:23:41 +0200 (CEST) Subject: [slime-cvs] CVS update: slime/slime.el Message-ID: <20050418192341.7CA8988030@common-lisp.net> Update of /project/slime/cvsroot/slime In directory common-lisp.net:/tmp/cvs-serv23912 Modified Files: slime.el Log Message: (inferior-lisp-program): Defvar it here, in case it is not defined in loaddefs and inf-lisp is not loaded. (That's the case in XEmacs.) Date: Mon Apr 18 21:23:41 2005 Author: heller Index: slime/slime.el diff -u slime/slime.el:1.483 slime/slime.el:1.484 --- slime/slime.el:1.483 Thu Apr 14 17:40:08 2005 +++ slime/slime.el Mon Apr 18 21:23:40 2005 @@ -1180,6 +1180,11 @@ (defvar slime-inferior-lisp-program-history '() "History list of command strings. Used by `slime'.") +;; XXX: inferior-lisp-program isn't preloaded in XEmacs. maybe we +;; should use something else. +(defvar inferior-lisp-program "lisp" + "*Program name for invoking an inferior Lisp with for Inferior Lisp mode.") + (defun slime (&optional command buffer coding-system) "Start an inferior^_superior Lisp and connect to its Swank server." (interactive (list (if current-prefix-arg From heller at common-lisp.net Mon Apr 18 19:39:13 2005 From: heller at common-lisp.net (Helmut Eller) Date: Mon, 18 Apr 2005 21:39:13 +0200 (CEST) Subject: [slime-cvs] CVS update: slime/ChangeLog Message-ID: <20050418193913.4F09D88030@common-lisp.net> Update of /project/slime/cvsroot/slime In directory common-lisp.net:/tmp/cvs-serv24820 Modified Files: ChangeLog Log Message: *** empty log message *** Date: Mon Apr 18 21:39:12 2005 Author: heller Index: slime/ChangeLog diff -u slime/ChangeLog:1.665 slime/ChangeLog:1.666 --- slime/ChangeLog:1.665 Mon Apr 18 06:45:04 2005 +++ slime/ChangeLog Mon Apr 18 21:39:12 2005 @@ -1,3 +1,13 @@ +2005-04-18 Helmut Eller + + * slime.el (inferior-lisp-program): Defvar it here, in case it is + not defined in loaddefs and inf-lisp is not loaded. (That's the + case in XEmacs.) + + * mkdist.sh: update version number. + + * doc/slime.texi: Update version numbers for SBCL and ACL. + 2005-04-17 Peter Seibel * swank-loader.lisp (*implementation-features*): Added features From heller at common-lisp.net Tue Apr 19 20:17:55 2005 From: heller at common-lisp.net (Helmut Eller) Date: Tue, 19 Apr 2005 22:17:55 +0200 (CEST) Subject: [slime-cvs] CVS update: slime/swank-sbcl.lisp Message-ID: <20050419201755.C653A88678@common-lisp.net> Update of /project/slime/cvsroot/slime In directory common-lisp.net:/tmp/cvs-serv15802 Modified Files: swank-sbcl.lisp Log Message: (preferred-communication-style): Don't test for sb-futex, it has lost its meaning 0.8.21. Date: Tue Apr 19 22:17:55 2005 Author: heller Index: slime/swank-sbcl.lisp diff -u slime/swank-sbcl.lisp:1.129 slime/swank-sbcl.lisp:1.130 --- slime/swank-sbcl.lisp:1.129 Sat Apr 9 09:07:00 2005 +++ slime/swank-sbcl.lisp Tue Apr 19 22:17:55 2005 @@ -42,10 +42,7 @@ ;;; TCP Server (defimplementation preferred-communication-style () - (if (and (sb-int:featurep :sb-thread) - (sb-int:featurep :sb-futex)) - :spawn - :fd-handler)) + (if (sb-int:featurep :sb-thread) :spawn :fd-handler)) (defun resolve-hostname (name) (car (sb-bsd-sockets:host-ent-addresses From heller at common-lisp.net Tue Apr 19 20:18:37 2005 From: heller at common-lisp.net (Helmut Eller) Date: Tue, 19 Apr 2005 22:18:37 +0200 (CEST) Subject: [slime-cvs] CVS update: slime/swank-backend.lisp Message-ID: <20050419201837.4D44A88678@common-lisp.net> Update of /project/slime/cvsroot/slime In directory common-lisp.net:/tmp/cvs-serv15844 Modified Files: swank-backend.lisp Log Message: Fix some typos. Date: Tue Apr 19 22:18:36 2005 Author: heller Index: slime/swank-backend.lisp diff -u slime/swank-backend.lisp:1.83 slime/swank-backend.lisp:1.84 --- slime/swank-backend.lisp:1.83 Sat Mar 12 02:48:47 2005 +++ slime/swank-backend.lisp Tue Apr 19 22:18:36 2005 @@ -471,7 +471,7 @@ (definterface disassemble-frame (frame-number) "Disassemble the code for the FRAME-NUMBER. The output should be written to standard output. -FRAME-NUMBER is a non-negative interger.") +FRAME-NUMBER is a non-negative integer.") (definterface eval-in-frame (form frame-number) "Evaluate a Lisp form in the lexical context of a stack frame @@ -701,7 +701,7 @@ ,(with-output-to-string (desc) (describe object desc))))) -;;; Utilities to for inspector methods. +;;; Utilities for inspector methods. ;;; (defun label-value-line (label value) "Create a control list which prints \"LABEL: VALUE\" in the inspector." @@ -793,8 +793,7 @@ "Send OBJECT to thread THREAD.") (definterface receive () - "Return the next message from current thread's mailbox." - nil) + "Return the next message from current thread's mailbox.") (definterface toggle-trace (spec) "Toggle tracing of the function(s) given with SPEC. From heller at common-lisp.net Tue Apr 19 20:23:57 2005 From: heller at common-lisp.net (Helmut Eller) Date: Tue, 19 Apr 2005 22:23:57 +0200 (CEST) Subject: [slime-cvs] CVS update: slime/PROBLEMS Message-ID: <20050419202357.DE73F88678@common-lisp.net> Update of /project/slime/cvsroot/slime In directory common-lisp.net:/tmp/cvs-serv15887 Modified Files: PROBLEMS Log Message: Warn about old kernels. Date: Tue Apr 19 22:23:57 2005 Author: heller Index: slime/PROBLEMS diff -u slime/PROBLEMS:1.4 slime/PROBLEMS:1.5 --- slime/PROBLEMS:1.4 Sun Mar 27 21:41:46 2005 +++ slime/PROBLEMS Tue Apr 19 22:23:57 2005 @@ -21,8 +21,8 @@ ** SBCL -SBCL versions from 0.8.15 to 0.8.20 should work. Newer SBCL's may or -may not work. +SBCL versions from 0.8.15 to 0.8.21 should work. Newer SBCL's may or +may not work. Don't use multithreading with 2.4 kernels. The (v)iew-source command in the debugger can only locate exact source forms for code compiled at (debug 2) or higher. The default level is From heller at common-lisp.net Tue Apr 19 20:24:49 2005 From: heller at common-lisp.net (Helmut Eller) Date: Tue, 19 Apr 2005 22:24:49 +0200 (CEST) Subject: [slime-cvs] CVS update: slime/ChangeLog Message-ID: <20050419202449.F3FF188678@common-lisp.net> Update of /project/slime/cvsroot/slime In directory common-lisp.net:/tmp/cvs-serv15925 Modified Files: ChangeLog Log Message: *** empty log message *** Date: Tue Apr 19 22:24:49 2005 Author: heller Index: slime/ChangeLog diff -u slime/ChangeLog:1.666 slime/ChangeLog:1.667 --- slime/ChangeLog:1.666 Mon Apr 18 21:39:12 2005 +++ slime/ChangeLog Tue Apr 19 22:24:49 2005 @@ -1,3 +1,15 @@ +2005-04-19 heller + + * /project/slime/cvsroot/slime/PROBLEMS: Warn about old kernels. +2005-04-19 Helmut Eller + + * PROBLEMS: Warn about old kernels. + + * swank-backend.lisp: Fix some typos. + + * swank-sbcl.lisp (preferred-communication-style): Don't test for + sb-futex, it has lost its meaning in 0.8.21. + 2005-04-18 Helmut Eller * slime.el (inferior-lisp-program): Defvar it here, in case it is From lgorrie at common-lisp.net Wed Apr 20 10:23:30 2005 From: lgorrie at common-lisp.net (Luke Gorrie) Date: Wed, 20 Apr 2005 12:23:30 +0200 (CEST) Subject: [slime-cvs] CVS update: slime/swank-sbcl.lisp Message-ID: <20050420102330.6458588671@common-lisp.net> Update of /project/slime/cvsroot/slime In directory common-lisp.net:/tmp/cvs-serv32680 Modified Files: swank-sbcl.lisp Log Message: (communication-style): Use `linux_no_threads_p' alien variable to decide whether to use :SPAWN. From dan_b for compatibility with new SBCLs. Date: Wed Apr 20 12:23:29 2005 Author: lgorrie Index: slime/swank-sbcl.lisp diff -u slime/swank-sbcl.lisp:1.130 slime/swank-sbcl.lisp:1.131 --- slime/swank-sbcl.lisp:1.130 Tue Apr 19 22:17:55 2005 +++ slime/swank-sbcl.lisp Wed Apr 20 12:23:29 2005 @@ -41,6 +41,12 @@ ;;; TCP Server +(defun communication-style () + (if (and (member :sb-thread *features*) + (not (sb-alien:extern-alien "linux_no_threads_p" sb-alien:boolean))) + :spawn + :fd-handler)) + (defimplementation preferred-communication-style () (if (sb-int:featurep :sb-thread) :spawn :fd-handler)) From lgorrie at common-lisp.net Wed Apr 20 10:26:36 2005 From: lgorrie at common-lisp.net (Luke Gorrie) Date: Wed, 20 Apr 2005 12:26:36 +0200 (CEST) Subject: [slime-cvs] CVS update: slime/ChangeLog Message-ID: <20050420102636.257A688671@common-lisp.net> Update of /project/slime/cvsroot/slime In directory common-lisp.net:/tmp/cvs-serv32723 Modified Files: ChangeLog Log Message: *** empty log message *** Date: Wed Apr 20 12:26:35 2005 Author: lgorrie Index: slime/ChangeLog diff -u slime/ChangeLog:1.667 slime/ChangeLog:1.668 --- slime/ChangeLog:1.667 Tue Apr 19 22:24:49 2005 +++ slime/ChangeLog Wed Apr 20 12:26:35 2005 @@ -1,3 +1,9 @@ +2005-04-20 Luke Gorrie + + * swank-sbcl.lisp (communication-style): Use `linux_no_threads_p' + alien variable to decide whether to use :SPAWN. From dan_b for + compatibility with new SBCLs. + 2005-04-19 heller * /project/slime/cvsroot/slime/PROBLEMS: Warn about old kernels. From lgorrie at common-lisp.net Wed Apr 20 12:43:50 2005 From: lgorrie at common-lisp.net (Luke Gorrie) Date: Wed, 20 Apr 2005 14:43:50 +0200 (CEST) Subject: [slime-cvs] CVS update: slime/swank-sbcl.lisp Message-ID: <20050420124350.7826688671@common-lisp.net> Update of /project/slime/cvsroot/slime In directory common-lisp.net:/tmp/cvs-serv8119 Modified Files: swank-sbcl.lisp Log Message: Fixed preferred-communication-style (last fix was broken). Date: Wed Apr 20 14:43:49 2005 Author: lgorrie Index: slime/swank-sbcl.lisp diff -u slime/swank-sbcl.lisp:1.131 slime/swank-sbcl.lisp:1.132 --- slime/swank-sbcl.lisp:1.131 Wed Apr 20 12:23:29 2005 +++ slime/swank-sbcl.lisp Wed Apr 20 14:43:49 2005 @@ -41,14 +41,11 @@ ;;; TCP Server -(defun communication-style () +(defimplementation preferred-communication-style () (if (and (member :sb-thread *features*) (not (sb-alien:extern-alien "linux_no_threads_p" sb-alien:boolean))) :spawn :fd-handler)) - -(defimplementation preferred-communication-style () - (if (sb-int:featurep :sb-thread) :spawn :fd-handler)) (defun resolve-hostname (name) (car (sb-bsd-sockets:host-ent-addresses From lgorrie at common-lisp.net Wed Apr 20 17:23:46 2005 From: lgorrie at common-lisp.net (Luke Gorrie) Date: Wed, 20 Apr 2005 19:23:46 +0200 (CEST) Subject: [slime-cvs] CVS update: slime/swank.lisp Message-ID: <20050420172346.A1ED988032@common-lisp.net> Update of /project/slime/cvsroot/slime In directory common-lisp.net:/tmp/cvs-serv24998 Modified Files: swank.lisp Log Message: (arglist-to-string): Bind *PRINT-ESCAPE* to NIL. This way symbols in arglists are printed as with PRINC, i.e. without package qualifier. Date: Wed Apr 20 19:23:45 2005 Author: lgorrie Index: slime/swank.lisp diff -u slime/swank.lisp:1.293 slime/swank.lisp:1.294 --- slime/swank.lisp:1.293 Sat Apr 9 09:07:46 2005 +++ slime/swank.lisp Wed Apr 20 19:23:45 2005 @@ -1216,7 +1216,7 @@ (cons (with-output-to-string (*standard-output*) (with-standard-io-syntax - (let ((*package* package) (*print-case* :downcase) + (let ((*package* package) (*print-case* :downcase) (*print-escape* nil) (*print-pretty* t) (*print-circle* nil) (*print-readably* nil) (*print-level* 10) (*print-length* 20)) (pprint-logical-block (nil nil :prefix "(" :suffix ")") From lgorrie at common-lisp.net Wed Apr 20 17:27:53 2005 From: lgorrie at common-lisp.net (Luke Gorrie) Date: Wed, 20 Apr 2005 19:27:53 +0200 (CEST) Subject: [slime-cvs] CVS update: slime/ChangeLog Message-ID: <20050420172753.D288488032@common-lisp.net> Update of /project/slime/cvsroot/slime In directory common-lisp.net:/tmp/cvs-serv25042 Modified Files: ChangeLog Log Message: *** empty log message *** Date: Wed Apr 20 19:27:53 2005 Author: lgorrie Index: slime/ChangeLog diff -u slime/ChangeLog:1.668 slime/ChangeLog:1.669 --- slime/ChangeLog:1.668 Wed Apr 20 12:26:35 2005 +++ slime/ChangeLog Wed Apr 20 19:27:52 2005 @@ -1,8 +1,12 @@ 2005-04-20 Luke Gorrie - * swank-sbcl.lisp (communication-style): Use `linux_no_threads_p' - alien variable to decide whether to use :SPAWN. From dan_b for - compatibility with new SBCLs. + * swank.lisp (arglist-to-string): Bind *PRINT-ESCAPE* to NIL. This + way symbols in arglists are printed as with PRINC, i.e. without + package qualifier. + + * swank-sbcl.lisp (preferred-communication-style): Use + `linux_no_threads_p' alien variable to decide whether to use + :SPAWN. From dan_b for compatibility with new SBCLs. 2005-04-19 heller From lgorrie at common-lisp.net Thu Apr 21 07:39:13 2005 From: lgorrie at common-lisp.net (Luke Gorrie) Date: Thu, 21 Apr 2005 09:39:13 +0200 (CEST) Subject: [slime-cvs] CVS update: slime/swank.lisp Message-ID: <20050421073913.C4E20880E6@common-lisp.net> Update of /project/slime/cvsroot/slime In directory common-lisp.net:/tmp/cvs-serv10261 Modified Files: swank.lisp Log Message: (arglist-to-string): Rolled back the previous change because it interferred with values appearing in parameter lists. Date: Thu Apr 21 09:39:12 2005 Author: lgorrie Index: slime/swank.lisp diff -u slime/swank.lisp:1.294 slime/swank.lisp:1.295 --- slime/swank.lisp:1.294 Wed Apr 20 19:23:45 2005 +++ slime/swank.lisp Thu Apr 21 09:39:12 2005 @@ -1216,7 +1216,7 @@ (cons (with-output-to-string (*standard-output*) (with-standard-io-syntax - (let ((*package* package) (*print-case* :downcase) (*print-escape* nil) + (let ((*package* package) (*print-case* :downcase) (*print-pretty* t) (*print-circle* nil) (*print-readably* nil) (*print-level* 10) (*print-length* 20)) (pprint-logical-block (nil nil :prefix "(" :suffix ")") From lgorrie at common-lisp.net Thu Apr 21 07:40:06 2005 From: lgorrie at common-lisp.net (Luke Gorrie) Date: Thu, 21 Apr 2005 09:40:06 +0200 (CEST) Subject: [slime-cvs] CVS update: slime/ChangeLog Message-ID: <20050421074006.09A45880E6@common-lisp.net> Update of /project/slime/cvsroot/slime In directory common-lisp.net:/tmp/cvs-serv10295 Modified Files: ChangeLog Log Message: *** empty log message *** Date: Thu Apr 21 09:40:02 2005 Author: lgorrie Index: slime/ChangeLog diff -u slime/ChangeLog:1.669 slime/ChangeLog:1.670 --- slime/ChangeLog:1.669 Wed Apr 20 19:27:52 2005 +++ slime/ChangeLog Thu Apr 21 09:40:01 2005 @@ -1,3 +1,8 @@ +2005-04-21 Luke Gorrie + + * swank.lisp (arglist-to-string): Rolled back the previous change + because it interferred with values appearing in parameter lists. + 2005-04-20 Luke Gorrie * swank.lisp (arglist-to-string): Bind *PRINT-ESCAPE* to NIL. This From lgorrie at common-lisp.net Thu Apr 21 12:06:49 2005 From: lgorrie at common-lisp.net (Luke Gorrie) Date: Thu, 21 Apr 2005 14:06:49 +0200 (CEST) Subject: [slime-cvs] CVS update: slime/ChangeLog Message-ID: <20050421120649.D551F880E6@common-lisp.net> Update of /project/slime/cvsroot/slime In directory common-lisp.net:/tmp/cvs-serv25884 Modified Files: ChangeLog Log Message: Fixed a couple of entries for the benefit of the contributor-listing generator. Date: Thu Apr 21 14:06:49 2005 Author: lgorrie Index: slime/ChangeLog diff -u slime/ChangeLog:1.670 slime/ChangeLog:1.671 --- slime/ChangeLog:1.670 Thu Apr 21 09:40:01 2005 +++ slime/ChangeLog Thu Apr 21 14:06:48 2005 @@ -13,9 +13,10 @@ `linux_no_threads_p' alien variable to decide whether to use :SPAWN. From dan_b for compatibility with new SBCLs. -2005-04-19 heller +2005-04-19 Helmut Eller * /project/slime/cvsroot/slime/PROBLEMS: Warn about old kernels. + 2005-04-19 Helmut Eller * PROBLEMS: Warn about old kernels. @@ -1422,7 +1423,7 @@ * swank-cmucl.lisp (return-from-frame): Add it. -2004-10-11 Thomas Burdick +2004-10-11 Thomas F. Burdick * swank-sbcl.lisp (function-definitions): Find compiler macros, too. (find-defintions, compiler-definitions) From lgorrie at common-lisp.net Thu Apr 21 12:07:43 2005 From: lgorrie at common-lisp.net (Luke Gorrie) Date: Thu, 21 Apr 2005 14:07:43 +0200 (CEST) Subject: [slime-cvs] CVS update: slime/ChangeLog Message-ID: <20050421120743.26157880E6@common-lisp.net> Update of /project/slime/cvsroot/slime In directory common-lisp.net:/tmp/cvs-serv25917 Modified Files: ChangeLog Log Message: *** empty log message *** Date: Thu Apr 21 14:07:42 2005 Author: lgorrie Index: slime/ChangeLog diff -u slime/ChangeLog:1.671 slime/ChangeLog:1.672 --- slime/ChangeLog:1.671 Thu Apr 21 14:06:48 2005 +++ slime/ChangeLog Thu Apr 21 14:07:42 2005 @@ -15,10 +15,6 @@ 2005-04-19 Helmut Eller - * /project/slime/cvsroot/slime/PROBLEMS: Warn about old kernels. - -2005-04-19 Helmut Eller - * PROBLEMS: Warn about old kernels. * swank-backend.lisp: Fix some typos. From heller at common-lisp.net Wed Apr 27 14:47:22 2005 From: heller at common-lisp.net (Helmut Eller) Date: Wed, 27 Apr 2005 16:47:22 +0200 (CEST) Subject: [slime-cvs] CVS update: slime/swank-cmucl.lisp Message-ID: <20050427144722.D6CBD88030@common-lisp.net> Update of /project/slime/cvsroot/slime In directory common-lisp.net:/tmp/cvs-serv22402 Modified Files: swank-cmucl.lisp Log Message: (+header-type-symbols+): Drop the third arg to apropos-list; it's no longer supported recent CMUCLs. Date: Wed Apr 27 16:47:22 2005 Author: heller Index: slime/swank-cmucl.lisp diff -u slime/swank-cmucl.lisp:1.143 slime/swank-cmucl.lisp:1.144 --- slime/swank-cmucl.lisp:1.143 Mon Apr 4 01:27:41 2005 +++ slime/swank-cmucl.lisp Wed Apr 27 16:47:22 2005 @@ -1788,18 +1788,18 @@ The `symbol-value' of each element is a type tag.") (defconstant +header-type-symbols+ - (flet ((suffixp (suffix string) - (and (>= (length string) (length suffix)) - (string= string suffix :start1 (- (length string) - (length suffix)))))) - ;; Is there a convinient place for all those constants? - (remove-if-not - (lambda (x) (and (suffixp "-TYPE" (symbol-name x)) - (not (member x +lowtag-symbols+)) - (boundp x) - (typep (symbol-value x) 'fixnum))) - (append (apropos-list "-TYPE" "VM" t) - (apropos-list "-TYPE" "BIGNUM" t)))) + (labels ((suffixp (suffix string) + (and (>= (length string) (length suffix)) + (string= string suffix :start1 (- (length string) + (length suffix))))) + (header-type-symbol-p (x) + (and (suffixp "-TYPE" (symbol-name x)) + (not (member x +lowtag-symbols+)) + (boundp x) + (typep (symbol-value x) 'fixnum)))) + (remove-if-not #'header-type-symbol-p + (append (apropos-list "-TYPE" "VM") + (apropos-list "-TYPE" "BIGNUM")))) "A list of names of the type codes in boxed objects.") (defimplementation describe-primitive-type (object) From heller at common-lisp.net Wed Apr 27 14:48:20 2005 From: heller at common-lisp.net (Helmut Eller) Date: Wed, 27 Apr 2005 16:48:20 +0200 (CEST) Subject: [slime-cvs] CVS update: slime/ChangeLog Message-ID: <20050427144820.4815188030@common-lisp.net> Update of /project/slime/cvsroot/slime In directory common-lisp.net:/tmp/cvs-serv22430 Modified Files: ChangeLog Log Message: *** empty log message *** Date: Wed Apr 27 16:48:19 2005 Author: heller Index: slime/ChangeLog diff -u slime/ChangeLog:1.672 slime/ChangeLog:1.673 --- slime/ChangeLog:1.672 Thu Apr 21 14:07:42 2005 +++ slime/ChangeLog Wed Apr 27 16:48:18 2005 @@ -1,3 +1,8 @@ +2005-04-27 Helmut Eller + + * swank-cmucl.lisp (+header-type-symbols+): Drop the third arg to + apropos-list; it's no longer supported recent CMUCLs. + 2005-04-21 Luke Gorrie * swank.lisp (arglist-to-string): Rolled back the previous change From heller at common-lisp.net Wed Apr 27 14:54:42 2005 From: heller at common-lisp.net (Helmut Eller) Date: Wed, 27 Apr 2005 16:54:42 +0200 (CEST) Subject: [slime-cvs] CVS update: slime/ChangeLog Message-ID: <20050427145442.266B088030@common-lisp.net> Update of /project/slime/cvsroot/slime In directory common-lisp.net:/tmp/cvs-serv22480 Modified Files: ChangeLog Log Message: *** empty log message *** Date: Wed Apr 27 16:54:41 2005 Author: heller Index: slime/ChangeLog diff -u slime/ChangeLog:1.673 slime/ChangeLog:1.674 --- slime/ChangeLog:1.673 Wed Apr 27 16:48:18 2005 +++ slime/ChangeLog Wed Apr 27 16:54:41 2005 @@ -1,7 +1,7 @@ 2005-04-27 Helmut Eller * swank-cmucl.lisp (+header-type-symbols+): Drop the third arg to - apropos-list; it's no longer supported recent CMUCLs. + apropos-list; it's no longer supported in recent CMUCLs. 2005-04-21 Luke Gorrie From heller at common-lisp.net Thu Apr 28 23:30:26 2005 From: heller at common-lisp.net (Helmut Eller) Date: Fri, 29 Apr 2005 01:30:26 +0200 (CEST) Subject: [slime-cvs] CVS update: slime/swank-cmucl.lisp Message-ID: <20050428233026.917AD88709@common-lisp.net> Update of /project/slime/cvsroot/slime In directory common-lisp.net:/tmp/cvs-serv28931 Modified Files: swank-cmucl.lisp Log Message: Be more carefully when tracing methods: try both (METHOD ...) and (PCL:FAST-METHOD ...). Date: Fri Apr 29 01:30:25 2005 Author: heller Index: slime/swank-cmucl.lisp diff -u slime/swank-cmucl.lisp:1.144 slime/swank-cmucl.lisp:1.145 --- slime/swank-cmucl.lisp:1.144 Wed Apr 27 16:47:22 2005 +++ slime/swank-cmucl.lisp Fri Apr 29 01:30:25 2005 @@ -2136,9 +2136,13 @@ (let ((name (second spec))) (toggle-trace-aux name :methods name))) ((:defmethod) - (toggle-trace-aux `(method ,(cdr spec))) - ;; Man, is this ugly - (toggle-trace-aux `(pcl::fast-method ,(cdr spec)))) + (cond ((fboundp `(method ,@(cdr spec))) + (toggle-trace-aux `(method ,(cdr spec)))) + ;; Man, is this ugly + ((fboundp `(pcl::fast-method ,@(cdr spec))) + (toggle-trace-aux `(pcl::fast-method ,@(cdr spec)))) + (t + (error 'undefined-function :name (cdr spec))))) ((:call) (destructuring-bind (caller callee) (cdr spec) (toggle-trace-aux (process-fspec callee) From heller at common-lisp.net Thu Apr 28 23:31:42 2005 From: heller at common-lisp.net (Helmut Eller) Date: Fri, 29 Apr 2005 01:31:42 +0200 (CEST) Subject: [slime-cvs] CVS update: slime/slime.el Message-ID: <20050428233142.7B3FB88709@common-lisp.net> Update of /project/slime/cvsroot/slime In directory common-lisp.net:/tmp/cvs-serv29420 Modified Files: slime.el Log Message: (slime-parse-context): Fix method parsing so that pressing, say, C-c C-t when point is on a '-' in a symbol name won't break. (slime-browser-map): New variable. Add support for the common 'q' keystroke to quit out of the xref. (slime-fetch-browsable-xrefs): New function. Remove the (FLET ...) entries which appear on at least CMUCL. I don't believe you can actually expand them on any current implementation and they just mess up the browse tree. Use only the method name when lookuping up (METHOD ...) entries on CMUCL. This really shouldn't be here, but I can't see how to avoid the error thrown by swank:xref. (slime-expand-xrefs): Use it. (slime-call-with-browser-setup): Initialize slime-buffer-package properly. Previously, lisp-mode was called after setting it, but lisp-mode clears all local variables, use lisp-mode-variables instead. Date: Fri Apr 29 01:31:41 2005 Author: heller Index: slime/slime.el diff -u slime/slime.el:1.484 slime/slime.el:1.485 --- slime/slime.el:1.484 Mon Apr 18 21:23:40 2005 +++ slime/slime.el Fri Apr 29 01:31:34 2005 @@ -5587,7 +5587,7 @@ (backward-up-list 1) (slime-parse-context `(setf ,name))) ((slime-in-expression-p '(defmethod *)) - (unless (looking-at "\\>\\|\\s ") + (unless (looking-at "\\s ") (forward-sexp 1)) ; skip over the methodname (let (qualifiers arglist) (loop for e = (read (current-buffer)) @@ -7485,47 +7485,73 @@ :dynargs 'slime-expand-class-node :has-echildren t)))) +(defvar slime-browser-map nil + "Keymap for tree widget browsers") + +(require 'tree-widget) +(unless slime-browser-map + (setq slime-browser-map (make-sparse-keymap)) + (set-keymap-parent slime-browser-map widget-keymap) + (define-key slime-browser-map "q" 'bury-buffer)) + (defun slime-call-with-browser-setup (buffer package title fn) - (require 'tree-widget) (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) + (save-excursion + (funcall fn)) + (lisp-mode-variables t) (slime-mode t) - (use-local-map widget-keymap) + (use-local-map slime-browser-map) (widget-setup)) - + ;;;; Xref browser +(defun slime-fetch-browsable-xrefs (type name) + "Return a list ((LABEL DSPEC)). +LABEL is just a string for display purposes. +DSPEC can be used to expand the node." + (let ((xrefs '())) + (loop for (_file . specs) in (slime-eval `(swank:xref ,type ,name)) do + (loop for (dspec . _location) in specs do + (let ((exp (ignore-errors (read (downcase dspec))))) + (cond ((and (consp exp) (eq 'flet (car exp))) + ;; we can't expand FLET references so they're useless + ) + ((and (consp exp) (eq 'method (car exp))) + ;; this isn't quite right, but good enough for now + (push (list dspec (string (second exp))) xrefs)) + (t + (push (list dspec dspec) xrefs)))))) + xrefs)) + (defun slime-expand-xrefs (widget) (or (widget-get widget :args) - (let ((name (widget-get widget :tag)) - (type (widget-get widget :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)))))) + (let* ((type (widget-get widget :xref-type)) + (dspec (widget-get widget :xref-dspec)) + (xrefs (slime-fetch-browsable-xrefs type dspec))) + (loop for (label dspec) in xrefs + collect `(tree-widget :tag ,label + :xref-type ,type + :xref-dspec ,dspec + :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 ":")))) + (interactive + (list (slime-read-from-minibuffer "Name: " + (slime-symbol-name-at-point)) + (read (completing-read "Type: " (slime-bogus-completion-alist + '(":callers" ":callees" ":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 + (widget-create 'tree-widget :tag name :xref-type type :xref-dspec name :dynargs 'slime-expand-xrefs :has-echildren t)))) From heller at common-lisp.net Thu Apr 28 23:32:30 2005 From: heller at common-lisp.net (Helmut Eller) Date: Fri, 29 Apr 2005 01:32:30 +0200 (CEST) Subject: [slime-cvs] CVS update: slime/ChangeLog Message-ID: <20050428233230.8251B88709@common-lisp.net> Update of /project/slime/cvsroot/slime In directory common-lisp.net:/tmp/cvs-serv29643 Modified Files: ChangeLog Log Message: *** empty log message *** Date: Fri Apr 29 01:32:29 2005 Author: heller Index: slime/ChangeLog diff -u slime/ChangeLog:1.674 slime/ChangeLog:1.675 --- slime/ChangeLog:1.674 Wed Apr 27 16:54:41 2005 +++ slime/ChangeLog Fri Apr 29 01:32:29 2005 @@ -1,3 +1,25 @@ +2005-04-29 Dan Pierson + + * slime.el (slime-parse-context): Fix method parsing so that + pressing, say, C-c C-t when point is on a '-' in a symbol name + won't break. + (slime-browser-map): New variable. Add support for the common 'q' + keystroke to quit out of the xref. + (slime-fetch-browsable-xrefs): New function. Remove the (FLET ...) + entries which appear on at least CMUCL. I don't believe you can + actually expand them on any current implementation and they just + mess up the browse tree. Use only the method name when looking + up (METHOD ...) entries on CMUCL. This really shouldn't be here, + but I can't see how to avoid the error thrown by swank:xref. + (slime-expand-xrefs): Use it. + (slime-call-with-browser-setup): Initialize slime-buffer-package + properly. Previously, lisp-mode was called after setting it, but + lisp-mode clears all local variables, use lisp-mode-variables + instead. + + * swank-cmucl.lisp (toggle-trace): Be more carefully when tracing + methods: try both (METHOD ...) and (PCL:FAST-METHOD ...). + 2005-04-27 Helmut Eller * swank-cmucl.lisp (+header-type-symbols+): Drop the third arg to