From heller at common-lisp.net Mon Jan 10 19:32:08 2005 From: heller at common-lisp.net (Helmut Eller) Date: Mon, 10 Jan 2005 20:32:08 +0100 (CET) Subject: [slime-cvs] CVS update: slime/slime.el Message-ID: <20050110193208.1C951884A5@common-lisp.net> Update of /project/slime/cvsroot/slime In directory common-lisp.net:/tmp/cvs-serv27352 Modified Files: slime.el Log Message: (slime-conservative-indentation): The default is now nil. Suggested by Travis Cross. (slime-inspector-next-inspectable-object): Accept a prefix argument and make wrapping around more reliable. The code is adapted from `widget-move'. (slime-inspector-previous-inspectable-object): New command. (slime-inspector-mode-map): Bind to S-TAB. Date: Mon Jan 10 20:32:02 2005 Author: heller Index: slime/slime.el diff -u slime/slime.el:1.443 slime/slime.el:1.444 --- slime/slime.el:1.443 Thu Dec 16 23:24:41 2004 +++ slime/slime.el Mon Jan 10 20:32:00 2005 @@ -6882,18 +6882,60 @@ (set-window-configuration slime-saved-window-config) (kill-buffer (current-buffer))) -(defun slime-inspector-next-inspectable-object () - "sets the point to the next inspectable object" - (interactive) - (let ((pos (if (get-text-property (point) 'slime-part-number) - ;; we're in a part - (next-single-property-change - (or (next-single-property-change (point) 'slime-part-number) (point-min)) - 'slime-part-number) - ;; go to the next part or wrap around - (or (next-single-property-change (point) 'slime-part-number) - (next-single-property-change (point-min) 'slime-part-number))))) - (when pos (goto-char pos)))) +(defun slime-inspector-next-inspectable-object (arg) + "Move point to the next inspectable object. +With optional ARG, move across that many objects. +If ARG is negative, move backwards." + (interactive "p") + (or (bobp) (> arg 0) (backward-char)) + (let ((wrapped 0) + (number arg) + (old (get-text-property (point) 'slime-part-number)) + new) + ;; Forward. + (while (> arg 0) + (cond ((eobp) + (goto-char (point-min)) + (setq wrapped (1+ wrapped))) + (t + (goto-char (or (next-single-property-change (point) + 'slime-part-number) + (point-max))))) + (and (= wrapped 2) + (eq arg number) + (error "No inspectable objects")) + (let ((new (get-text-property (point) 'slime-part-number))) + (when new + (unless (eq new old) + (setq arg (1- arg)) + (setq old new))))) + ;; Backward. + (while (< arg 0) + (cond ((bobp) + (goto-char (point-max)) + (setq wrapped (1+ wrapped))) + (t + (goto-char (or (previous-single-property-change + (point) 'slime-part-number) + (point-min))))) + (and (= wrapped 2) + (eq arg number) + (error "No inspectable objects")) + (let ((new (get-text-property (point) 'slime-part-number))) + (when new + (unless (eq new old) + (setq arg (1+ arg)))))) + (let ((new (get-text-property (point) 'slime-part-number))) + (while (eq (get-text-property (point) 'slime-part-number) new) + (backward-char))) + (forward-char))) + +(defun slime-inspector-previous-inspectable-object (arg) + "Move point to the previous inspectable object. +With optional ARG, move across that many objects. +If ARG is negative, move forwards." + (interactive "p") + (slime-inspector-next-inspectable-object (- arg))) (defun slime-inspector-describe () (interactive) @@ -6909,6 +6951,7 @@ ("d" 'slime-inspector-describe) ("q" 'slime-inspector-quit) ("\C-i" 'slime-inspector-next-inspectable-object) + ([(shift tab)] 'slime-inspector-previous-inspectable-object) ("\M-." 'slime-edit-definition)) @@ -7256,7 +7299,7 @@ ;;;; Indentation -(defcustom slime-conservative-indentation t +(defcustom slime-conservative-indentation nil "If true then don't discover indentation of \"with-\" or \"def\" symbols." :type 'boolean :group 'slime-mode) From heller at common-lisp.net Mon Jan 10 19:33:31 2005 From: heller at common-lisp.net (Helmut Eller) Date: Mon, 10 Jan 2005 20:33:31 +0100 (CET) Subject: [slime-cvs] CVS update: slime/swank-sbcl.lisp Message-ID: <20050110193331.2780C884A5@common-lisp.net> Update of /project/slime/cvsroot/slime In directory common-lisp.net:/tmp/cvs-serv27398 Modified Files: swank-sbcl.lisp Log Message: (profile-package): Add implementation for SBCL. Date: Mon Jan 10 20:33:30 2005 Author: heller Index: slime/swank-sbcl.lisp diff -u slime/swank-sbcl.lisp:1.115 slime/swank-sbcl.lisp:1.116 --- slime/swank-sbcl.lisp:1.115 Mon Nov 29 18:35:03 2004 +++ slime/swank-sbcl.lisp Mon Jan 10 20:33:29 2005 @@ -158,8 +158,6 @@ ;;; Utilities -(defvar *swank-debugger-stack-frame*) - (defimplementation arglist ((fname t)) (sb-introspect:function-arglist fname)) @@ -647,6 +645,10 @@ (defimplementation profiled-functions () (sb-profile:profile)) +(defimplementation profile-package (package callers methods) + (declare (ignore callers methods)) + (eval `(sb-profile:profile ,(package-name (find-package package))))) + ;;;; Inspector @@ -773,11 +775,8 @@ (ecase (first feature) (:or (some #'subfeature-in-list-p (rest feature))) (:and (every #'subfeature-in-list-p (rest feature))) - (:not (let ((rest (cdr feature))) - (if (or (null (car rest)) (cdr rest)) - (error "wrong number of terms in compound feature ~S" - feature) - (not (subfeature-in-list-p (second feature))))))))))) + (:not (destructuring-bind (e) (cdr feature) + (not (subfeature-in-list-p e))))))))) (defun shebang-reader (stream sub-character infix-parameter) (declare (ignore sub-character)) From heller at common-lisp.net Mon Jan 10 19:34:33 2005 From: heller at common-lisp.net (Helmut Eller) Date: Mon, 10 Jan 2005 20:34:33 +0100 (CET) Subject: [slime-cvs] CVS update: slime/swank.lisp Message-ID: <20050110193433.57145884A5@common-lisp.net> Update of /project/slime/cvsroot/slime In directory common-lisp.net:/tmp/cvs-serv27424 Modified Files: swank.lisp Log Message: (inspect-for-emacs-list): LispWorks has a low args limit for apply: use reduce instead of apply. Date: Mon Jan 10 20:34:31 2005 Author: heller Index: slime/swank.lisp diff -u slime/swank.lisp:1.272 slime/swank.lisp:1.273 --- slime/swank.lisp:1.272 Thu Dec 16 22:16:50 2004 +++ slime/swank.lisp Mon Jan 10 20:34:31 2005 @@ -2631,7 +2631,7 @@ (let ((a (if (null l) a (cons (label-value-line :tail l) a)))) - (apply #'append (reverse a))))))) + (reduce #'append (reverse a) :from-end t)))))) (values title (append '("Elements:" (:newline)) lines))))) (cond ((not length) ; circular From heller at common-lisp.net Mon Jan 10 19:35:09 2005 From: heller at common-lisp.net (Helmut Eller) Date: Mon, 10 Jan 2005 20:35:09 +0100 (CET) Subject: [slime-cvs] CVS update: slime/ChangeLog Message-ID: <20050110193509.14B5C884A5@common-lisp.net> Update of /project/slime/cvsroot/slime In directory common-lisp.net:/tmp/cvs-serv27449 Modified Files: ChangeLog Log Message: *** empty log message *** Date: Mon Jan 10 20:35:07 2005 Author: heller Index: slime/ChangeLog diff -u slime/ChangeLog:1.594 slime/ChangeLog:1.595 --- slime/ChangeLog:1.594 Tue Dec 21 14:48:40 2004 +++ slime/ChangeLog Mon Jan 10 20:35:07 2005 @@ -1,3 +1,25 @@ +2005-01-10 Utz-Uwe Haus + + * swank-sbcl.lisp (profile-package): Add implementation for SBCL. + +2005-01-10 Eduardo Mu?oz + + * swank.lisp (inspect-for-emacs-list): LispWorks has a low args + limit for apply: use reduce instead of apply. + +2005-01-10 Helmut Eller + + * slime.el (slime-conservative-indentation): The default is now + nil. Suggested by Travis Cross. + +2005-01-10 Matthias Koeppe + + * slime.el (slime-inspector-next-inspectable-object): Accept a + prefix argument and make wrapping around more reliable. The code + is adapted from `widget-move'. + (slime-inspector-previous-inspectable-object): New command. + (slime-inspector-mode-map): Bind to S-TAB. + 2004-12-16 Martin Simmons * swank-lispworks.lisp (create-socket): Work around bug in From heller at common-lisp.net Wed Jan 12 16:22:43 2005 From: heller at common-lisp.net (Helmut Eller) Date: Wed, 12 Jan 2005 17:22:43 +0100 (CET) Subject: [slime-cvs] CVS update: slime/swank.lisp Message-ID: <20050112162243.79BE6884A9@common-lisp.net> Update of /project/slime/cvsroot/slime In directory common-lisp.net:/tmp/cvs-serv789 Modified Files: swank.lisp Log Message: (*default-worker-thread-bindings*): New variable to initialize dynamic variables in worker threads. (spawn-worker-thread, call-with-bindings): New helper functions. (thread-for-evaluation): Use them. Date: Wed Jan 12 17:22:37 2005 Author: heller Index: slime/swank.lisp diff -u slime/swank.lisp:1.273 slime/swank.lisp:1.274 --- slime/swank.lisp:1.273 Mon Jan 10 20:34:31 2005 +++ slime/swank.lisp Wed Jan 12 17:22:37 2005 @@ -447,6 +447,11 @@ ;;;;;; Thread based communication +(defvar *default-worker-thread-bindings* '() + "An alist to initialize dynamic variables in worker threads. +The list has the form ((VAR . VALUE) ...). Each variable VAR will be +bound to the corresponding VALUE.") + (defvar *active-threads* '()) (defun read-loop (control-thread input-stream connection) @@ -487,11 +492,24 @@ (let ((c *emacs-connection*)) (etypecase id ((member t) - (spawn (lambda () (handle-request c)) :name "worker")) + (spawn-worker-thread c)) ((member :repl-thread) (repl-thread c)) (fixnum (find-thread id))))) + +(defun spawn-worker-thread (connection) + (spawn (lambda () + (call-with-bindings *default-worker-thread-bindings* + (lambda () + (handle-request connection)))) + :name "worker")) + +(defun call-with-bindings (alist fn) + (let ((vars (mapcar #'car alist)) + (vals (mapcar #'cdr alist))) + (progv vars vals + (funcall fn)))) (defun dispatch-event (event socket-io) "Handle an event triggered either by Emacs or within Lisp." From heller at common-lisp.net Wed Jan 12 16:25:19 2005 From: heller at common-lisp.net (Helmut Eller) Date: Wed, 12 Jan 2005 17:25:19 +0100 (CET) Subject: [slime-cvs] CVS update: slime/swank.lisp Message-ID: <20050112162519.1B6B9884A9@common-lisp.net> Update of /project/slime/cvsroot/slime In directory common-lisp.net:/tmp/cvs-serv844 Modified Files: swank.lisp Log Message: *** empty log message *** Date: Wed Jan 12 17:25:17 2005 Author: heller Index: slime/swank.lisp diff -u slime/swank.lisp:1.274 slime/swank.lisp:1.275 --- slime/swank.lisp:1.274 Wed Jan 12 17:22:37 2005 +++ slime/swank.lisp Wed Jan 12 17:25:16 2005 @@ -35,6 +35,7 @@ #:*sldb-print-level* #:*sldb-print-lines* #:*sldb-print-pprint-dispatch* + #:*default-worker-thread-bindings* ;; These are re-exported directly from the backend: #:buffer-first-change #:frame-source-location-for-emacs From heller at common-lisp.net Wed Jan 12 16:54:47 2005 From: heller at common-lisp.net (Helmut Eller) Date: Wed, 12 Jan 2005 17:54:47 +0100 (CET) Subject: [slime-cvs] CVS update: slime/slime.el Message-ID: <20050112165447.EA369884A9@common-lisp.net> Update of /project/slime/cvsroot/slime In directory common-lisp.net:/tmp/cvs-serv2375 Modified Files: slime.el Log Message: (slime-inspector-operate-on-click): New command for inspecting the value value at the clicked-at position or invoking an inspector action. (slime-inspector-mode-map): Bind it to mouse-2. (slime-inspector-insert-ispec): Add mouse-face properties for clickable values and action buttons. Date: Wed Jan 12 17:54:43 2005 Author: heller Index: slime/slime.el diff -u slime/slime.el:1.444 slime/slime.el:1.445 --- slime/slime.el:1.444 Mon Jan 10 20:32:00 2005 +++ slime/slime.el Wed Jan 12 17:54:41 2005 @@ -6826,10 +6826,12 @@ (destructure-case ispec ((:value string id) (slime-insert-propertized (list 'slime-part-number id + 'mouse-face 'highlight 'face 'slime-inspector-value-face) string)) ((:action string id) (slime-insert-propertized (list 'slime-action-number id + 'mouse-face 'highlight 'face 'slime-inspector-action-face) string))))) @@ -6849,6 +6851,18 @@ (lambda (parts) (slime-open-inspector parts point)))))))) +(defun slime-inspector-operate-on-click (event) + "Inspect the value at the clicked-at position or invoke an action." + (interactive "@e") + (let ((point (posn-point (event-end event)))) + (cond ((and point + (or (get-text-property point 'slime-part-number) + (get-text-property point 'slime-action-number))) + (goto-char point) + (slime-inspector-operate-on-point)) + (t + (error "No clickable part here"))))) + (defun slime-inspector-copy-down (number) "Evaluate the slot at point via the REPL (to set `*')." (interactive (list (or (get-text-property (point) 'slime-part-number) @@ -6945,6 +6959,7 @@ ([return] 'slime-inspector-operate-on-point) ([(meta return)] 'slime-inspector-copy-down) ("\C-m" 'slime-inspector-operate-on-point) + ([mouse-2] 'slime-inspector-operate-on-click) ("l" 'slime-inspector-pop) ("n" 'slime-inspector-next) (" " 'slime-inspector-next) From heller at common-lisp.net Wed Jan 12 17:08:53 2005 From: heller at common-lisp.net (Helmut Eller) Date: Wed, 12 Jan 2005 18:08:53 +0100 (CET) Subject: [slime-cvs] CVS update: slime/slime.el Message-ID: <20050112170853.05668884A9@common-lisp.net> Update of /project/slime/cvsroot/slime In directory common-lisp.net:/tmp/cvs-serv3415 Modified Files: slime.el Log Message: (slime-changelog-date): Return nil if the ChangLog file doesn't exits. (slime-repl-update-banner): Write "ChangLog file not found" if the ChangeLog doesn't exist. Date: Wed Jan 12 18:08:48 2005 Author: heller Index: slime/slime.el diff -u slime/slime.el:1.445 slime/slime.el:1.446 --- slime/slime.el:1.445 Wed Jan 12 17:54:41 2005 +++ slime/slime.el Wed Jan 12 18:08:46 2005 @@ -2320,15 +2320,21 @@ (setq header-line-format banner)) (when animantep (pop-to-buffer (current-buffer)) - (animate-string (format "; SLIME %s" (slime-changelog-date)) 0 0)) + (animate-string (format "; SLIME %s" (or (slime-changelog-date) + "- ChangeLog file not found")) + 0 0)) (slime-repl-insert-prompt (if use-header-p "" (concat "; " banner))))) (defun slime-changelog-date () - "Return the datestring of the latest entry in the ChangeLog file." - (with-temp-buffer - (insert-file-contents (concat slime-path "ChangeLog") nil 0 100) - (goto-char (point-min)) - (symbol-name (read (current-buffer))))) + "Return the datestring of the latest entry in the ChangeLog file. +Return nil if the ChangeLog file cannot be found." + (let ((changelog (concat slime-path "ChangeLog"))) + (if (file-exists-p changelog) + (with-temp-buffer + (insert-file-contents changelog nil 0 100) + (goto-char (point-min)) + (symbol-name (read (current-buffer)))) + nil))) (defun slime-init-output-buffer (connection) (with-current-buffer (slime-output-buffer t) From heller at common-lisp.net Wed Jan 12 17:10:47 2005 From: heller at common-lisp.net (Helmut Eller) Date: Wed, 12 Jan 2005 18:10:47 +0100 (CET) Subject: [slime-cvs] CVS update: slime/ChangeLog Message-ID: <20050112171047.BFDB5884A9@common-lisp.net> Update of /project/slime/cvsroot/slime In directory common-lisp.net:/tmp/cvs-serv3510 Modified Files: ChangeLog Log Message: *** empty log message *** Date: Wed Jan 12 18:10:45 2005 Author: heller Index: slime/ChangeLog diff -u slime/ChangeLog:1.595 slime/ChangeLog:1.596 --- slime/ChangeLog:1.595 Mon Jan 10 20:35:07 2005 +++ slime/ChangeLog Wed Jan 12 18:10:44 2005 @@ -1,3 +1,26 @@ +2005-01-12 Robert Lehr + + * slime.el (slime-changelog-date): Return nil if the ChangLog file + doesn't exits. + (slime-repl-update-banner): Write "ChangeLog file not found" if + the ChangeLog doesn't exist. + +2005-01-12 Matthias Koeppe + + * slime.el (slime-inspector-operate-on-click): New command for + inspecting the value value at the clicked-at position or invoking + an inspector action. + (slime-inspector-mode-map): Bind it to mouse-2. + (slime-inspector-insert-ispec): Add mouse-face properties for + clickable values and action buttons. + +2005-01-12 Helmut Eller + + * swank.lisp (*default-worker-thread-bindings*): New variable to + initialize dynamic variables in worker threads. + (spawn-worker-thread, call-with-bindings): New helper functions. + (thread-for-evaluation): Use them. + 2005-01-10 Utz-Uwe Haus * swank-sbcl.lisp (profile-package): Add implementation for SBCL. From heller at common-lisp.net Thu Jan 13 23:17:04 2005 From: heller at common-lisp.net (Helmut Eller) Date: Fri, 14 Jan 2005 00:17:04 +0100 (CET) Subject: [slime-cvs] CVS update: slime/swank-cmucl.lisp Message-ID: <20050113231704.77A11884A5@common-lisp.net> Update of /project/slime/cvsroot/slime In directory common-lisp.net:/tmp/cvs-serv31508 Modified Files: swank-cmucl.lisp Log Message: (create-socket): The byte-order of the :host argument for CREATE-INET-LISTENER was changed in the Jan 2005 snapshot. Test whether the symbol 'ext:socket-error exists to decide if we are in a older version. (resolve-hostname): Return the address in host byte-order. Date: Fri Jan 14 00:17:03 2005 Author: heller Index: slime/swank-cmucl.lisp diff -u slime/swank-cmucl.lisp:1.135 slime/swank-cmucl.lisp:1.136 --- slime/swank-cmucl.lisp:1.135 Thu Dec 16 22:14:42 2004 +++ slime/swank-cmucl.lisp Fri Jan 14 00:17:02 2005 @@ -78,9 +78,11 @@ #-(or ppc mips) (defimplementation create-socket (host port) - (ext:create-inet-listener port :stream - :reuse-address t - :host (resolve-hostname host))) + (let* ((addr (resolve-hostname host)) + (addr (if (not (find-symbol "SOCKET-ERROR" :ext)) + (ext:htonl addr) + addr))) + (ext:create-inet-listener port :stream :reuse-address t :host addr))) ;; There seems to be a bug in create-inet-listener on Mac/OSX and Irix. #+(or ppc mips) @@ -109,10 +111,9 @@ (sys:fd-stream (sys:fd-stream-fd socket)))) (defun resolve-hostname (hostname) - "Return the IP address of HOSTNAME as an integer." - (let* ((hostent (ext:lookup-host-entry hostname)) - (address (car (ext:host-entry-addr-list hostent)))) - (ext:htonl address))) + "Return the IP address of HOSTNAME as an integer (in host byte-order)." + (let ((hostent (ext:lookup-host-entry hostname))) + (car (ext:host-entry-addr-list hostent)))) (defun make-socket-io-stream (fd) "Create a new input/output fd-stream for FD." From heller at common-lisp.net Thu Jan 13 23:21:20 2005 From: heller at common-lisp.net (Helmut Eller) Date: Fri, 14 Jan 2005 00:21:20 +0100 (CET) Subject: [slime-cvs] CVS update: slime/ChangeLog Message-ID: <20050113232120.21710884A5@common-lisp.net> Update of /project/slime/cvsroot/slime In directory common-lisp.net:/tmp/cvs-serv31564 Modified Files: ChangeLog Log Message: *** empty log message *** Date: Fri Jan 14 00:21:17 2005 Author: heller Index: slime/ChangeLog diff -u slime/ChangeLog:1.596 slime/ChangeLog:1.597 --- slime/ChangeLog:1.596 Wed Jan 12 18:10:44 2005 +++ slime/ChangeLog Fri Jan 14 00:21:16 2005 @@ -1,3 +1,11 @@ +2005-01-13 Helmut Eller + + * swank-cmucl.lisp (create-socket): The byte-order of the :host + argument for CREATE-INET-LISTENER was changed in the Jan 2005 + snapshot. Test whether the symbol 'ext:socket-error exists to + decide if we are in a older version. + (resolve-hostname): Return the address in host byte-order. + 2005-01-12 Robert Lehr * slime.el (slime-changelog-date): Return nil if the ChangLog file From eweitz at common-lisp.net Fri Jan 14 07:59:26 2005 From: eweitz at common-lisp.net (Edi Weitz) Date: Fri, 14 Jan 2005 08:59:26 +0100 (CET) Subject: [slime-cvs] CVS update: slime/ChangeLog slime/slime.el Message-ID: <20050114075926.C98CA884A5@common-lisp.net> Update of /project/slime/cvsroot/slime In directory common-lisp.net:/tmp/cvs-serv25920 Modified Files: ChangeLog slime.el Log Message: slime.el (slime-complete-symbol*): Maybe insert closing parenthesis or space after symbol completion has finished. Date: Fri Jan 14 08:59:21 2005 Author: eweitz Index: slime/ChangeLog diff -u slime/ChangeLog:1.597 slime/ChangeLog:1.598 --- slime/ChangeLog:1.597 Fri Jan 14 00:21:16 2005 +++ slime/ChangeLog Fri Jan 14 08:59:20 2005 @@ -1,3 +1,9 @@ +2005-01-14 Edi Weitz + + * slime.el (slime-complete-symbol*): Maybe insert closing + parenthesis or space (depending on arglist) after symbol + completion has finished. Optionally also show arglist. + 2005-01-13 Helmut Eller * swank-cmucl.lisp (create-socket): The byte-order of the :host Index: slime/slime.el diff -u slime/slime.el:1.446 slime/slime.el:1.447 --- slime/slime.el:1.446 Wed Jan 12 18:08:46 2005 +++ slime/slime.el Fri Jan 14 08:59:20 2005 @@ -4529,6 +4529,15 @@ (cond ((and (member completed-prefix completion-set) (= (length completion-set) 1)) (slime-minibuffer-respecting-message "Sole completion") + (let ((arglist (slime-get-arglist + (slime-symbol-name-at-point)))) + (when arglist + (if (cdr (read arglist)) + (progn (insert-and-inherit " ") + (when (and slime-space-information-p + (slime-background-activities-enabled-p)) + (slime-echo-arglist))) + (insert-and-inherit ")")))) (slime-complete-restore-window-configuration)) ;; Incomplete (t From lgorrie at common-lisp.net Fri Jan 14 17:08:37 2005 From: lgorrie at common-lisp.net (Luke Gorrie) Date: Fri, 14 Jan 2005 18:08:37 +0100 (CET) Subject: [slime-cvs] CVS update: slime/slime.el Message-ID: <20050114170837.D8FB6884A9@common-lisp.net> Update of /project/slime/cvsroot/slime In directory common-lisp.net:/tmp/cvs-serv21813 Modified Files: slime.el Log Message: (slime-repl-send-input): Make old input read-only using an overlay instead of a text property. This way if you copy&paste the input elsewhere it will become editable (overlay is associated with the buffer region and not the text). Date: Fri Jan 14 18:08:34 2005 Author: lgorrie Index: slime/slime.el diff -u slime/slime.el:1.447 slime/slime.el:1.448 --- slime/slime.el:1.447 Fri Jan 14 08:59:20 2005 +++ slime/slime.el Fri Jan 14 18:08:33 2005 @@ -2751,16 +2751,13 @@ rear-nonsticky (face slime-repl-old-input) slime-repl-old-input ,(incf slime-repl-old-input-counter))) - (slime-make-region-read-only slime-repl-input-start-mark (point)) + (let ((overlay (make-overlay slime-repl-input-start-mark (point)))) + (overlay-put overlay 'read-only t)) (let ((input (slime-repl-current-input))) (goto-char slime-repl-input-end-mark) (slime-mark-input-start) (slime-mark-output-start) (slime-repl-send-string input))) - -(defun slime-make-region-read-only (start end) - (add-text-properties (max start (1- end)) end '(rear-nonsticky (read-only))) - (add-text-properties start end `(read-only t))) (defun slime-repl-grab-old-input (replace) "Resend the old REPL input at point. From lgorrie at common-lisp.net Fri Jan 14 17:08:54 2005 From: lgorrie at common-lisp.net (Luke Gorrie) Date: Fri, 14 Jan 2005 18:08:54 +0100 (CET) Subject: [slime-cvs] CVS update: slime/ChangeLog Message-ID: <20050114170854.2301E8864C@common-lisp.net> Update of /project/slime/cvsroot/slime In directory common-lisp.net:/tmp/cvs-serv21835 Modified Files: ChangeLog Log Message: Date: Fri Jan 14 18:08:49 2005 Author: lgorrie Index: slime/ChangeLog diff -u slime/ChangeLog:1.598 slime/ChangeLog:1.599 --- slime/ChangeLog:1.598 Fri Jan 14 08:59:20 2005 +++ slime/ChangeLog Fri Jan 14 18:08:49 2005 @@ -1,3 +1,10 @@ +2005-01-14 Luke Gorrie + + * slime.el (slime-repl-send-input): Make old input read-only using + an overlay instead of a text property. This way if you copy&paste + the input elsewhere it will become editable (overlay is associated + with the buffer region and not the text). + 2005-01-14 Edi Weitz * slime.el (slime-complete-symbol*): Maybe insert closing From lgorrie at common-lisp.net Tue Jan 18 16:01:11 2005 From: lgorrie at common-lisp.net (Luke Gorrie) Date: Tue, 18 Jan 2005 08:01:11 -0800 (PST) Subject: [slime-cvs] CVS update: slime/slime.el Message-ID: <20050118160111.9D36C88028@common-lisp.net> Update of /project/slime/cvsroot/slime In directory common-lisp.net:/tmp/cvs-serv23049 Modified Files: slime.el Log Message: (slime-complete-symbol*-fancy): New variable to enable extra bells and whistles with slime-complete-symbol*. Currently controls whether to use arglists semantically. (slime-complete-symbol*): Avoid displaying an arglist when the minibuffer is active. Date: Tue Jan 18 08:01:10 2005 Author: lgorrie Index: slime/slime.el diff -u slime/slime.el:1.448 slime/slime.el:1.449 --- slime/slime.el:1.448 Fri Jan 14 09:08:33 2005 +++ slime/slime.el Tue Jan 18 08:01:10 2005 @@ -201,6 +201,9 @@ (const :tag "Compound" slime-complete-symbol*) (const :tag "Fuzzy" slime-fuzzy-complete-symbol))) +(defcustom slime-complete-symbol*-fancy nil + "Use information from argument lists for DWIM'ish symbol completion.") + (defcustom slime-space-information-p t "Have the SPC key offer arglist information." :type 'boolean @@ -4526,15 +4529,17 @@ (cond ((and (member completed-prefix completion-set) (= (length completion-set) 1)) (slime-minibuffer-respecting-message "Sole completion") - (let ((arglist (slime-get-arglist - (slime-symbol-name-at-point)))) - (when arglist - (if (cdr (read arglist)) - (progn (insert-and-inherit " ") - (when (and slime-space-information-p - (slime-background-activities-enabled-p)) - (slime-echo-arglist))) - (insert-and-inherit ")")))) + (when slime-complete-symbol*-fancy + (let ((arglist (slime-get-arglist + (slime-symbol-name-at-point)))) + (when arglist + (if (cdr (read arglist)) + (progn (insert-and-inherit " ") + (when (and slime-space-information-p + (slime-background-activities-enabled-p) + (not (minibuffer-window-active-p))) + (slime-echo-arglist))) + (insert-and-inherit ")"))))) (slime-complete-restore-window-configuration)) ;; Incomplete (t From lgorrie at common-lisp.net Tue Jan 18 16:03:17 2005 From: lgorrie at common-lisp.net (Luke Gorrie) Date: Tue, 18 Jan 2005 08:03:17 -0800 (PST) Subject: [slime-cvs] CVS update: slime/ChangeLog Message-ID: <20050118160317.129CF88028@common-lisp.net> Update of /project/slime/cvsroot/slime In directory common-lisp.net:/tmp/cvs-serv23082 Modified Files: ChangeLog Log Message: Date: Tue Jan 18 08:03:16 2005 Author: lgorrie Index: slime/ChangeLog diff -u slime/ChangeLog:1.599 slime/ChangeLog:1.600 --- slime/ChangeLog:1.599 Fri Jan 14 09:08:49 2005 +++ slime/ChangeLog Tue Jan 18 08:03:16 2005 @@ -1,3 +1,11 @@ +2005-01-18 Luke Gorrie + + * slime.el (slime-complete-symbol*-fancy): New variable to enable + extra bells and whistles with slime-complete-symbol*. Currently + controls whether to use arglists semantically. + (slime-complete-symbol*): Avoid displaying an arglist when the + minibuffer is active. + 2005-01-14 Luke Gorrie * slime.el (slime-repl-send-input): Make old input read-only using From lgorrie at common-lisp.net Tue Jan 18 16:21:28 2005 From: lgorrie at common-lisp.net (Luke Gorrie) Date: Tue, 18 Jan 2005 08:21:28 -0800 (PST) Subject: [slime-cvs] CVS update: slime/slime.el Message-ID: <20050118162128.5C1DD88028@common-lisp.net> Update of /project/slime/cvsroot/slime In directory common-lisp.net:/tmp/cvs-serv23970 Modified Files: slime.el Log Message: (slime-complete-symbol*-fancy): Now defaults to t. (slime-complete-symbol*-fancy-bit): Factored out this function. Only do "semantic" completion when the symbol is in function-position, avoid interning argument names in Emacs, and don't display arglists if the minibuffer is active. Date: Tue Jan 18 08:21:27 2005 Author: lgorrie Index: slime/slime.el diff -u slime/slime.el:1.449 slime/slime.el:1.450 --- slime/slime.el:1.449 Tue Jan 18 08:01:10 2005 +++ slime/slime.el Tue Jan 18 08:21:27 2005 @@ -201,7 +201,7 @@ (const :tag "Compound" slime-complete-symbol*) (const :tag "Fuzzy" slime-fuzzy-complete-symbol))) -(defcustom slime-complete-symbol*-fancy nil +(defcustom slime-complete-symbol*-fancy t "Use information from argument lists for DWIM'ish symbol completion.") (defcustom slime-space-information-p t @@ -4530,16 +4530,7 @@ (= (length completion-set) 1)) (slime-minibuffer-respecting-message "Sole completion") (when slime-complete-symbol*-fancy - (let ((arglist (slime-get-arglist - (slime-symbol-name-at-point)))) - (when arglist - (if (cdr (read arglist)) - (progn (insert-and-inherit " ") - (when (and slime-space-information-p - (slime-background-activities-enabled-p) - (not (minibuffer-window-active-p))) - (slime-echo-arglist))) - (insert-and-inherit ")"))))) + (slime-complete-symbol*-fancy-bit)) (slime-complete-restore-window-configuration)) ;; Incomplete (t @@ -4552,6 +4543,28 @@ (goto-char (+ beg unambiguous-completion-length)) (slime-display-completion-list completion-set) (slime-complete-delay-restoration))))))) + +(defun slime-complete-symbol*-fancy-bit () + "Do fancy tricks after completing a symbol. +\(Insert a space or close-paren based on arglist information.)" + (let ((arglist (slime-get-arglist (slime-symbol-name-at-point)))) + (when arglist + (let ((args + ;; Don't intern these symbols + (let ((obarray (make-vector 10 0))) + (cdr (read arglist)))) + (function-call-position-p + (save-excursion + (backward-sexp) + (equal (char-before) ?\()))) + (when function-call-position-p + (if (null args) + (insert-and-inherit ")") + (insert-and-inherit " ") + (when (and slime-space-information-p + (slime-background-activities-enabled-p) + (not (minibuffer-window-active-p (minibuffer-window)))) + (slime-echo-arglist)))))))) (defun* slime-simple-complete-symbol () "Complete the symbol at point. From lgorrie at common-lisp.net Wed Jan 19 11:58:43 2005 From: lgorrie at common-lisp.net (Luke Gorrie) Date: Wed, 19 Jan 2005 03:58:43 -0800 (PST) Subject: [slime-cvs] CVS update: slime/slime.el Message-ID: <20050119115843.0823B88027@common-lisp.net> Update of /project/slime/cvsroot/slime In directory common-lisp.net:/tmp/cvs-serv19219 Modified Files: slime.el Log Message: (slime-header-line-p): Customize variable to enable/disable the header-line in the REPL. Date: Wed Jan 19 03:58:41 2005 Author: lgorrie Index: slime/slime.el diff -u slime/slime.el:1.450 slime/slime.el:1.451 --- slime/slime.el:1.450 Tue Jan 18 08:21:27 2005 +++ slime/slime.el Wed Jan 19 03:58:39 2005 @@ -2276,6 +2276,11 @@ ;;;; Stream output +(defcustom slime-header-line-p t + "If non-nil, display a header line in Slime buffers." + :type 'boolean + :group 'slime-repl) + (make-variable-buffer-local (defvar slime-output-start nil "Marker for the start of the output for the evaluation.")) @@ -2314,7 +2319,8 @@ (slime-connection-port (slime-connection)) (slime-pid))) ;; Emacs21 has the fancy persistent header-line. - (use-header-p (boundp 'header-line-format)) + (use-header-p (and slime-header-line-p + (boundp 'header-line-format))) ;; and dancing text (animantep (and (fboundp 'animate-string) slime-startup-animation From lgorrie at common-lisp.net Wed Jan 19 11:58:55 2005 From: lgorrie at common-lisp.net (Luke Gorrie) Date: Wed, 19 Jan 2005 03:58:55 -0800 (PST) Subject: [slime-cvs] CVS update: slime/ChangeLog Message-ID: <20050119115855.8897088027@common-lisp.net> Update of /project/slime/cvsroot/slime In directory common-lisp.net:/tmp/cvs-serv19237 Modified Files: ChangeLog Log Message: *** empty log message *** Date: Wed Jan 19 03:58:54 2005 Author: lgorrie Index: slime/ChangeLog diff -u slime/ChangeLog:1.600 slime/ChangeLog:1.601 --- slime/ChangeLog:1.600 Tue Jan 18 08:03:16 2005 +++ slime/ChangeLog Wed Jan 19 03:58:54 2005 @@ -1,10 +1,17 @@ +2005-01-19 Lars Magne Ingebrigtsen + + * slime.el (slime-header-line-p): Customize variable to + enable/disable the header-line in the REPL. + 2005-01-18 Luke Gorrie * slime.el (slime-complete-symbol*-fancy): New variable to enable extra bells and whistles with slime-complete-symbol*. Currently - controls whether to use arglists semantically. - (slime-complete-symbol*): Avoid displaying an arglist when the - minibuffer is active. + controls whether to use arglists semantically. Default is t. + (slime-complete-symbol*-fancy-bit): Factored out this function. + Only do "semantic" completion when the symbol is in + function-position, avoid interning argument names in Emacs, and + don't display arglists if the minibuffer is active. 2005-01-14 Luke Gorrie From heller at common-lisp.net Wed Jan 19 18:27:48 2005 From: heller at common-lisp.net (Helmut Eller) Date: Wed, 19 Jan 2005 10:27:48 -0800 (PST) Subject: [slime-cvs] CVS update: slime/swank-cmucl.lisp Message-ID: <20050119182748.9777D88027@common-lisp.net> Update of /project/slime/cvsroot/slime In directory common-lisp.net:/tmp/cvs-serv6753 Modified Files: swank-cmucl.lisp Log Message: (breakpoint): Add a slot for return values to make return values inspectable in the debugger. (signal-breakpoint): Initialize the new slot. Date: Wed Jan 19 10:27:47 2005 Author: heller Index: slime/swank-cmucl.lisp diff -u slime/swank-cmucl.lisp:1.136 slime/swank-cmucl.lisp:1.137 --- slime/swank-cmucl.lisp:1.136 Thu Jan 13 15:17:02 2005 +++ slime/swank-cmucl.lisp Wed Jan 19 10:27:47 2005 @@ -1727,7 +1727,8 @@ (c::compiled-debug-function-returns cdfun))) (define-condition breakpoint (simple-condition) - ((message :initarg :message :reader breakpoint.message)) + ((message :initarg :message :reader breakpoint.message) + (values :initarg :values :reader breakpoint.values)) (:report (lambda (c stream) (princ (breakpoint.message c) stream)))) (defimplementation condition-extras ((c breakpoint)) @@ -1737,23 +1738,24 @@ (defun signal-breakpoint (breakpoint frame) "Signal a breakpoint condition for BREAKPOINT in FRAME. Try to create a informative message." - (flet ((brk (fstring &rest args) + (flet ((brk (values fstring &rest args) (let ((msg (apply #'format nil fstring args)) (debug:*stack-top-hint* frame)) - (break 'breakpoint :message msg)))) - (with-struct (di::breakpoint- kind what) breakpoint - (case kind - (:code-location - (case (di:code-location-kind what) - ((:single-value-return :known-return :unknown-return) - (brk "Return value: ~{~S ~}" (breakpoint-values breakpoint))) - (t - (brk "Breakpoint: ~S ~S" - (di:code-location-kind what) - (di::compiled-code-location-pc what))))) - (:function-start - (brk "Function start breakpoint")) - (t (brk "Breakpoint: ~A in ~A" breakpoint frame)))))) + (break 'breakpoint :message msg :values values)))) + (with-struct (di::breakpoint- kind what) breakpoint + (case kind + (:code-location + (case (di:code-location-kind what) + ((:single-value-return :known-return :unknown-return) + (let ((values (breakpoint-values breakpoint))) + (brk values "Return value: ~{~S ~}" values))) + (t + (brk nil "Breakpoint: ~S ~S" + (di:code-location-kind what) + (di::compiled-code-location-pc what))))) + (:function-start + (brk nil "Function start breakpoint")) + (t (brk nil "Breakpoint: ~A in ~A" breakpoint frame)))))) (defimplementation sldb-break-at-start (fname) (let ((debug-fun (di:function-debug-function (coerce fname 'function)))) From heller at common-lisp.net Wed Jan 19 18:28:38 2005 From: heller at common-lisp.net (Helmut Eller) Date: Wed, 19 Jan 2005 10:28:38 -0800 (PST) Subject: [slime-cvs] CVS update: slime/swank-gray.lisp Message-ID: <20050119182838.9080588027@common-lisp.net> Update of /project/slime/cvsroot/slime In directory common-lisp.net:/tmp/cvs-serv6785 Modified Files: swank-gray.lisp Log Message: (stream-unread-char): If the char argument doesn't match the contents in the buffer ignore it and emit a warning instead. Date: Wed Jan 19 10:28:37 2005 Author: heller Index: slime/swank-gray.lisp diff -u slime/swank-gray.lisp:1.6 slime/swank-gray.lisp:1.7 --- slime/swank-gray.lisp:1.6 Sat Sep 18 23:11:14 2004 +++ slime/swank-gray.lisp Wed Jan 19 10:28:37 2005 @@ -66,7 +66,12 @@ (defmethod stream-unread-char ((s slime-input-stream) char) (with-slots (buffer index) s - (setf (aref buffer (decf index)) char)) + (decf index) + (cond ((eql (aref buffer index) char) + (setf (aref buffer index) char)) + (t + (warn "stream-unread-char: ignoring ~S (expected ~S)" + char (aref buffer index))))) nil) (defmethod stream-clear-input ((s slime-input-stream)) From heller at common-lisp.net Wed Jan 19 18:30:39 2005 From: heller at common-lisp.net (Helmut Eller) Date: Wed, 19 Jan 2005 10:30:39 -0800 (PST) Subject: [slime-cvs] CVS update: slime/swank.lisp Message-ID: <20050119183039.224A488027@common-lisp.net> Update of /project/slime/cvsroot/slime In directory common-lisp.net:/tmp/cvs-serv7219 Modified Files: swank.lisp Log Message: (arglist-to-template-string): New function. (arglist-for-insertion): Use it (decode-keyword-arg, decode-optional-arg): New functions. Date: Wed Jan 19 10:30:37 2005 Author: heller Index: slime/swank.lisp diff -u slime/swank.lisp:1.275 slime/swank.lisp:1.276 --- slime/swank.lisp:1.275 Wed Jan 12 08:25:16 2005 +++ slime/swank.lisp Wed Jan 19 10:30:36 2005 @@ -1162,17 +1162,91 @@ (*print-length* 10) (*print-circle* t)) (format nil "~A => ~A" sym (symbol-value sym))))))) +(defun decode-keyword-arg (arg) + "Decode a keyword item of formal argument list. +Return three values: keyword, argument name, default arg." + (cond ((symbolp arg) + (values (intern (symbol-name arg) keyword-package) + arg + nil)) + ((and (consp arg) + (consp (car arg))) + (values (caar arg) + (cadar arg) + (cadr arg))) + ((consp arg) + (values (intern (symbol-name (car arg)) keyword-package) + (car arg) + (cadr arg))) + (t + (error "Bad keyword item of formal argument list")))) + +(defmacro values-equal? (exp (&rest values)) + "Are the values produced by EXP equal to VALUES." + `(equal (multiple-value-list ,exp) (list , at values))) + +(progn + (assert (values-equal? (decode-keyword-arg 'x) (:x 'x nil))) + (assert (values-equal? (decode-keyword-arg '(x t)) (:x 'x t))) + (assert (values-equal? (decode-keyword-arg '((:x y))) (:x 'y nil))) + (assert (values-equal? (decode-keyword-arg '((:x y) t)) (:x 'y t)))) + +(defun decode-optional-arg (arg) + "Decode an optional item of a formal argument list. +Return two values: argument name, default arg." + (etypecase arg + (symbol (values arg nil)) + (list (values (car arg) (cadr arg))))) + +(progn + (assert (values-equal? (decode-optional-arg 'x) ('x nil))) + (assert (values-equal? (decode-optional-arg '(x t)) ('x t)))) + +(defun arglist-to-template-string (arglist package) + "Print the list ARGLIST for insertion as a template for a function call." + (setq arglist (clean-arglist arglist)) + (etypecase arglist + (null "()") + (cons + (with-output-to-string (*standard-output*) + (with-standard-io-syntax + (let ((*package* package) (*print-case* :downcase) + (*print-pretty* t) (*print-circle* nil) (*print-readably* nil) + (*print-level* 10) (*print-length* 20)) + (pprint-logical-block (nil nil :prefix "(" :suffix ")") + (arglist-to-template-string-aux arglist)))))))) + +(defun arglist-to-template-string-aux (arglist) + (let ((mode nil)) + (loop + (let ((arg (pop arglist))) + (case arg + ((&key &optional &rest &body) + (setq mode arg)) + (t + (case mode + (&key (multiple-value-bind (key sym) (decode-keyword-arg arg) + (format t "~W ~A" key sym))) + (&optional (format t "[~A]" (decode-optional-arg arg))) + (&body (format t "~:@_~A..." arg)) + (&rest (format t "~A..." arg)) + (otherwise (princ arg))) + (unless (null arglist) + (write-char #\space))))) + (when (null arglist) (return)) + (pprint-newline :fill)))) + (defslimefun arglist-for-insertion (name) (with-buffer-syntax () (cond ((valid-operator-name-p name) (let ((arglist (arglist (parse-symbol name)))) (etypecase arglist ((member :not-available) - " ") + :not-available) (list - (arglist-to-string arglist *buffer-package*))))) + (arglist-to-template-string arglist *buffer-package*))))) (t - " ")))) + :not-available)))) ;;;; Evaluation From heller at common-lisp.net Wed Jan 19 18:31:37 2005 From: heller at common-lisp.net (Helmut Eller) Date: Wed, 19 Jan 2005 10:31:37 -0800 (PST) Subject: [slime-cvs] CVS update: slime/slime.el Message-ID: <20050119183137.323AA88027@common-lisp.net> Update of /project/slime/cvsroot/slime In directory common-lisp.net:/tmp/cvs-serv7546 Modified Files: slime.el Log Message: (slime-insert-arglist): Inserts a template for a function call instead of the plain arglist; this makes a difference for functions with optional and keyword arguments. Date: Wed Jan 19 10:31:35 2005 Author: heller Index: slime/slime.el diff -u slime/slime.el:1.451 slime/slime.el:1.452 --- slime/slime.el:1.451 Wed Jan 19 03:58:39 2005 +++ slime/slime.el Wed Jan 19 10:31:34 2005 @@ -4239,7 +4239,16 @@ "Insert the argument list for NAME behind the symbol point is currently looking at." (interactive (list (slime-read-symbol-name "Arglist of: "))) - (insert (slime-eval `(swank:arglist-for-insertion ',name)))) + (let ((arglist (slime-eval `(swank:arglist-for-insertion ',name)))) + (cond ((eq arglist :not-available) + (error "Arglist not available")) + ((string-match "^(" arglist) + (insert " ") + (save-excursion + (insert (substring arglist 1)))) + (t + (save-excursion + (insert arglist)))))) (defun slime-get-arglist (symbol-name) "Return the argument list for SYMBOL-NAME." From heller at common-lisp.net Wed Jan 19 18:32:17 2005 From: heller at common-lisp.net (Helmut Eller) Date: Wed, 19 Jan 2005 10:32:17 -0800 (PST) Subject: [slime-cvs] CVS update: slime/ChangeLog Message-ID: <20050119183217.CA2EF88027@common-lisp.net> Update of /project/slime/cvsroot/slime In directory common-lisp.net:/tmp/cvs-serv7579 Modified Files: ChangeLog Log Message: *** empty log message *** Date: Wed Jan 19 10:32:16 2005 Author: heller Index: slime/ChangeLog diff -u slime/ChangeLog:1.601 slime/ChangeLog:1.602 --- slime/ChangeLog:1.601 Wed Jan 19 03:58:54 2005 +++ slime/ChangeLog Wed Jan 19 10:32:16 2005 @@ -1,3 +1,25 @@ +2005-01-19 Helmut Eller + + * swank-gray.lisp (stream-unread-char): If the char argument + doesn't match the contents in the buffer, ignore it and emit a + warning instead. + +2005-01-19 Utz-Uwe Haus + + * swank-cmucl.lisp (breakpoint): Add a slot for return values to + make return values inspectable in the debugger. + (signal-breakpoint): Initialize the new slot. + +2005-01-19 Matthias Koeppe + + * slime.el (slime-insert-arglist): Inserts a template for a + function call instead of the plain arglist; this makes a + difference for functions with optional and keyword arguments. + + * swank.lisp (arglist-to-template-string): New function. + (arglist-for-insertion): Use it + (decode-keyword-arg, decode-optional-arg): New functions. + 2005-01-19 Lars Magne Ingebrigtsen * slime.el (slime-header-line-p): Customize variable to From heller at common-lisp.net Thu Jan 20 16:09:30 2005 From: heller at common-lisp.net (Helmut Eller) Date: Thu, 20 Jan 2005 08:09:30 -0800 (PST) Subject: [slime-cvs] CVS update: slime/swank-allegro.lisp Message-ID: <20050120160930.0E72088026@common-lisp.net> Update of /project/slime/cvsroot/slime In directory common-lisp.net:/tmp/cvs-serv9756 Modified Files: swank-allegro.lisp Log Message: (handle-undefined-functions-warning): Prevent breakage if the undefined function is called at multiple locations. By Edi Weitz. (restart-frame): Handle frames with arguments better. From Ian Eslick. Date: Thu Jan 20 08:09:24 2005 Author: heller Index: slime/swank-allegro.lisp diff -u slime/swank-allegro.lisp:1.66 slime/swank-allegro.lisp:1.67 --- slime/swank-allegro.lisp:1.66 Sun Dec 5 06:52:39 2004 +++ slime/swank-allegro.lisp Thu Jan 20 08:09:23 2005 @@ -201,12 +201,13 @@ frame (debugger:eval-form-in-context form (debugger:environment-of-frame frame))))) - -;;; XXX doesn't work for frames with arguments + (defimplementation restart-frame (frame-number) (let ((frame (nth-frame frame-number))) - (debugger:frame-retry frame (debugger:frame-function frame)))) - + (apply #'debugger:frame-retry + (append (list frame (debugger:frame-function frame)) + (cdr (debugger:frame-expression frame)))))) + ;;;; Compiler hooks (defvar *buffer-name* nil) @@ -257,14 +258,15 @@ (defun handle-undefined-functions-warning (condition) (let ((fargs (slot-value condition 'excl::format-arguments))) - (dolist (farg (car fargs)) - (destructuring-bind (fname (pos file)) farg - (signal-compiler-condition - :original-condition condition - :severity :warning - :message (format nil "Undefined function referenced: ~S" fname) - :location (make-location (list :file file) - (list :position (1+ pos)))))))) + (loop for (fname . pos-file) in (car fargs) do + (loop for (pos file) in pos-file do + (signal-compiler-condition + :original-condition condition + :severity :warning + :message (format nil "Undefined function referenced: ~S" + fname) + :location (make-location (list :file file) + (list :position (1+ pos)))))))) (defimplementation call-with-compilation-hooks (function) (handler-bind ((warning #'handle-compiler-warning) From heller at common-lisp.net Thu Jan 20 16:10:01 2005 From: heller at common-lisp.net (Helmut Eller) Date: Thu, 20 Jan 2005 08:10:01 -0800 (PST) Subject: [slime-cvs] CVS update: slime/ChangeLog Message-ID: <20050120161001.E850A88026@common-lisp.net> Update of /project/slime/cvsroot/slime In directory common-lisp.net:/tmp/cvs-serv9795 Modified Files: ChangeLog Log Message: *** empty log message *** Date: Thu Jan 20 08:09:58 2005 Author: heller Index: slime/ChangeLog diff -u slime/ChangeLog:1.602 slime/ChangeLog:1.603 --- slime/ChangeLog:1.602 Wed Jan 19 10:32:16 2005 +++ slime/ChangeLog Thu Jan 20 08:09:55 2005 @@ -1,3 +1,14 @@ +2005-01-20 Ian Eslick + + * swank-allegro.lisp (restart-frame): Handle frames with arguments + better. + +2005-01-20 Edi Weitz + + * swank-allegro.lisp (handle-undefined-functions-warning): Prevent + breakage if the undefined function is called at multiple + locations. + 2005-01-19 Helmut Eller * swank-gray.lisp (stream-unread-char): If the char argument From heller at common-lisp.net Thu Jan 20 20:02:33 2005 From: heller at common-lisp.net (Helmut Eller) Date: Thu, 20 Jan 2005 12:02:33 -0800 (PST) Subject: [slime-cvs] CVS update: slime/swank.lisp Message-ID: <20050120200233.AF07488026@common-lisp.net> Update of /project/slime/cvsroot/slime In directory common-lisp.net:/tmp/cvs-serv22148 Modified Files: swank.lisp Log Message: (parse-symbol): Don't break if the package doesn't exists. Date: Thu Jan 20 12:02:32 2005 Author: heller Index: slime/swank.lisp diff -u slime/swank.lisp:1.276 slime/swank.lisp:1.277 --- slime/swank.lisp:1.276 Wed Jan 19 10:30:36 2005 +++ slime/swank.lisp Thu Jan 20 12:02:32 2005 @@ -1012,27 +1012,25 @@ (defun casify (string) "Convert string accoring to readtable-case." (ecase (readtable-case *readtable*) - (:preserve - string) - (:upcase - (string-upcase string)) - (:downcase - (string-downcase string)) - (:invert - (multiple-value-bind (lower upper) (determine-case string) - (cond ((and lower upper) string) - (lower (string-upcase string)) - (upper (string-downcase string)) - (t string)))))) + (:preserve string) + (:upcase (string-upcase string)) + (:downcase (string-downcase string)) + (:invert (multiple-value-bind (lower upper) (determine-case string) + (cond ((and lower upper) string) + (lower (string-upcase string)) + (upper (string-downcase string)) + (t string)))))) (defun parse-symbol (string &optional (package *package*)) "Find the symbol named STRING. -Return the symbol and a flag indicateing if the symbols was found." +Return the symbol and a flag indicating whether the symbols was found." (multiple-value-bind (sname pname) (tokenize-symbol string) - (find-symbol (casify sname) - (cond ((string= pname "") "KEYWORD") - (pname (casify pname)) - (t package))))) + (let ((package (cond ((string= pname "") keyword-package) + (pname (find-package (casify pname))) + (t package)))) + (if package + (find-symbol (casify sname) package) + (values nil nil))))) (defun parse-symbol-or-lose (string &optional (package *package*)) (multiple-value-bind (symbol status) (parse-symbol string package) From heller at common-lisp.net Thu Jan 20 20:05:07 2005 From: heller at common-lisp.net (Helmut Eller) Date: Thu, 20 Jan 2005 12:05:07 -0800 (PST) Subject: [slime-cvs] CVS update: slime/ChangeLog Message-ID: <20050120200507.E45C788026@common-lisp.net> Update of /project/slime/cvsroot/slime In directory common-lisp.net:/tmp/cvs-serv22210 Modified Files: ChangeLog Log Message: *** empty log message *** Date: Thu Jan 20 12:05:06 2005 Author: heller Index: slime/ChangeLog diff -u slime/ChangeLog:1.603 slime/ChangeLog:1.604 --- slime/ChangeLog:1.603 Thu Jan 20 08:09:55 2005 +++ slime/ChangeLog Thu Jan 20 12:05:05 2005 @@ -1,3 +1,8 @@ +2005-01-20 Helmut Eller + + * swank.lisp (parse-symbol): Don't break if the package doesn't + exist. Reported by Lynn Quam. + 2005-01-20 Ian Eslick * swank-allegro.lisp (restart-frame): Handle frames with arguments From heller at common-lisp.net Thu Jan 27 19:54:46 2005 From: heller at common-lisp.net (Helmut Eller) Date: Thu, 27 Jan 2005 11:54:46 -0800 (PST) Subject: [slime-cvs] CVS update: slime/slime.el Message-ID: <20050127195446.6CD798802C@common-lisp.net> Update of /project/slime/cvsroot/slime In directory common-lisp.net:/tmp/cvs-serv23884 Modified Files: slime.el Log Message: (slime-busy-p): Ignore debugged continuations to enable arglist lookup while debugging. Suggested by Lynn Quam. (sldb-continuations): New buffer local variable in sldb buffers to keep track of debugged continuatons. (sldb-debugged-continuations): New function. (sldb-buffers): Renamed from sldb-remove-killed-buffers. (slime-eval-print): New function to insert the stream output and the result of an evaluation in the current buffer. (slime-eval-print-last-expression): Use it. (slime-interactive-eval): Use slime-eval-print when a prefix argument was given. Date: Thu Jan 27 11:54:45 2005 Author: heller Index: slime/slime.el diff -u slime/slime.el:1.452 slime/slime.el:1.453 --- slime/slime.el:1.452 Wed Jan 19 10:31:34 2005 +++ slime/slime.el Thu Jan 27 11:54:42 2005 @@ -2110,8 +2110,13 @@ (substitute-command-keys "\\[slime]")))) (defun slime-busy-p () - "True if Lisp has outstanding requests." - (slime-rex-continuations)) + "True if Lisp has outstanding requests. +Debugged requests are ignored." + (let ((debugged (sldb-debugged-continuations (slime-connection)))) + (remove-if (lambda (id) + (memq id debugged)) + (slime-rex-continuations) + :key #'car))) (defun slime-reading-p () "True if Lisp is currently reading input from the REPL." @@ -2172,9 +2177,9 @@ ((:debug-activate thread level) (assert thread) (sldb-activate thread level)) - ((:debug thread level condition restarts frames) + ((:debug thread level condition restarts frames conts) (assert thread) - (sldb-setup thread level condition restarts frames)) + (sldb-setup thread level condition restarts frames conts)) ((:debug-return thread level &optional stepping) (assert thread) (sldb-exit thread level stepping)) @@ -5127,18 +5132,28 @@ (defun slime-interactive-eval (string) "Read and evaluate STRING and print value in minibuffer. -Note: If a prefix argument is in effect then the result will be output -in the REPL." +Note: If a prefix argument is in effect then the result will be +inserted in the current buffer." (interactive (list (slime-read-from-minibuffer "Slime Eval: "))) (slime-insert-transcript-delimiter string) - (slime-eval-with-transcript `(swank:interactive-eval ,string) - (if current-prefix-arg - 'slime-output-string - 'slime-display-eval-result))) + (cond ((not current-prefix-arg) + (slime-eval-with-transcript `(swank:interactive-eval ,string) + 'slime-display-eval-result)) + (t + (slime-eval-print string)))) (defun slime-display-eval-result (value) (slime-message "%s" value)) +(defun slime-eval-print (string) + "Eval STRING in Lisp; insert any output and the result at point." + (slime-eval-async `(swank:eval-and-grab-output ,string) + (lexical-let ((buffer (current-buffer))) + (lambda (result) + (with-current-buffer buffer + (destructuring-bind (output value) result + (insert output value))))))) + (defun slime-eval-with-transcript (form &optional fn wait) "Send FROM and PACKAGE to Lisp and pass the result to FN. Display the result in the message area, if FN is nil. @@ -5240,14 +5255,8 @@ (defun slime-eval-print-last-expression (string) "Evalute sexp before point; print value into the current buffer" (interactive (list (slime-last-expression))) - (lexical-let ((buffer (current-buffer))) - (slime-eval-with-transcript - `(swank:interactive-eval ,string) - (lambda (result) (with-current-buffer buffer - (slime-show-last-output) - (insert "\n" - (format "%s" result) - "\n")))))) + (insert "\n") + (slime-eval-print string)) (defun slime-eval/compile-defun-dwim (&optional arg) "Call the computation command you want (Do What I Mean). @@ -5852,6 +5861,10 @@ (make-variable-buffer-local (defvar sldb-backtrace-start-marker nil "Marker placed at the beginning of the backtrace text.")) + +(make-variable-buffer-local + (defvar sldb-continuations nil + "List of ids for pending continuation.")) ;;;;; sldb-mode @@ -5986,19 +5999,18 @@ (defvar sldb-overlays '() "List of overlays created in source code buffers to highlight expressions.") +;; FIXME: Why are elements not of the form (connection thread buffer)? (defvar sldb-buffers '() - "List of sldb-buffers.") + "Alist of sldb-buffers of the form (((connection . thread) . buffer) ...)") -(defun sldb-remove-killed-buffers () +(defun sldb-buffers () (setq sldb-buffers (remove-if-not #'buffer-live-p sldb-buffers :key #'cdr))) (defun sldb-find-buffer (thread) - (sldb-remove-killed-buffers) - (cdr (assoc* (cons (slime-connection) thread) sldb-buffers :test #'equal))) + (cdr (assoc* (cons (slime-connection) thread) (sldb-buffers) :test #'equal))) (defun sldb-get-default-buffer () - (sldb-remove-killed-buffers) - (cdr (first sldb-buffers))) + (cdr (first (sldb-buffers)))) (defun sldb-get-buffer (thread) (or (sldb-find-buffer thread) @@ -6009,12 +6021,22 @@ sldb-buffers) buffer))) -(defun sldb-setup (thread level condition restarts frames) +(defun sldb-debugged-continuations (connection) + "Return the debugged continuations for CONNECTION." + (lexical-let ((accu '())) + (dolist (e (sldb-buffers)) + (when (eq (caar e) connection) + (with-current-buffer (cdr e) + (setq accu (append sldb-continuations accu))))) + accu)) + +(defun sldb-setup (thread level condition restarts frames conts) "Setup a new SLDB buffer. CONDITION is a string describing the condition to debug. RESTARTS is a list of strings (NAME DESCRIPTION) for each available restart. FRAMES is a list (NUMBER DESCRIPTION) describing the initial -portion of the backtrace. Frames are numbered from 0." +portion of the backtrace. Frames are numbered from 0. +CONTS is a list of pending Emacs continuations." (with-current-buffer (sldb-get-buffer thread) (unless (equal sldb-level level) (setq buffer-read-only nil) @@ -6026,6 +6048,7 @@ (setq mode-name (format "sldb[%d]" sldb-level)) (setq sldb-condition condition) (setq sldb-restarts restarts) + (setq sldb-continuations conts) (sldb-insert-condition condition) (insert (in-sldb-face section "Restarts:") "\n") (sldb-insert-restarts restarts) @@ -7653,7 +7676,7 @@ (defun slime-at-top-level-p () (and (not (sldb-get-default-buffer)) - (null (slime-busy-p)))) + (null (slime-rex-continuations)))) (defun slime-wait-condition (name predicate timeout) (let ((end (time-add (current-time) (seconds-to-time timeout)))) From heller at common-lisp.net Thu Jan 27 19:56:07 2005 From: heller at common-lisp.net (Helmut Eller) Date: Thu, 27 Jan 2005 11:56:07 -0800 (PST) Subject: [slime-cvs] CVS update: slime/swank.lisp Message-ID: <20050127195607.B4BAB8802C@common-lisp.net> Update of /project/slime/cvsroot/slime In directory common-lisp.net:/tmp/cvs-serv23919 Modified Files: swank.lisp Log Message: (*pending-continuations*, eval-in-emacs, debugger-info-for-emacs): Keep track of debugged continuation the new variable *pending-continuations* and include the list of active continuations in the debugger info for Emacs. (eval-and-grab-output): New function. Used by slime-eval-print. (*log-output*): Renamed from *log-io*. Use *standard-error* as initial value instead of *terminal-io*. CMUCL opens its own tty and that makes it hard to redirect to output with a shell. *standard-error* writes its output to file descriptor 2. (*canonical-package-nicknames*): Fix typo. Date: Thu Jan 27 11:56:06 2005 Author: heller Index: slime/swank.lisp diff -u slime/swank.lisp:1.277 slime/swank.lisp:1.278 --- slime/swank.lisp:1.277 Thu Jan 20 12:02:32 2005 +++ slime/swank.lisp Thu Jan 27 11:56:06 2005 @@ -63,7 +63,7 @@ (defconstant keyword-package (find-package :keyword) "The KEYWORD package.") -(defvar *canonical-packge-nicknames* +(defvar *canonical-package-nicknames* '(("COMMON-LISP-USER" . "CL-USER")) "Canonical package names to use instead of shortest name/nickname.") @@ -276,14 +276,14 @@ (delete-package ,var)))) (defvar *log-events* nil) -(defvar *log-io* *terminal-io*) +(defvar *log-output* *error-output*) (defun log-event (format-string &rest args) "Write a message to *terminal-io* when *log-events* is non-nil. Useful for low level debugging." (when *log-events* - (apply #'format *log-io* format-string args) - (force-output *log-io*))) + (apply #'format *log-output* format-string args) + (force-output *log-output*))) ;;;; TCP Server @@ -1249,6 +1249,9 @@ ;;;; Evaluation +(defvar *pending-continuations* '() + "List of continuations for Emacs. (thread local)") + (defun eval-in-emacs (form) "Execute FORM in Emacs." (destructuring-bind (fn &rest args) form @@ -1268,7 +1271,8 @@ (let (ok result) (unwind-protect (let ((*buffer-package* (guess-buffer-package buffer-package)) - (*buffer-readtable* (guess-buffer-readtable buffer-package))) + (*buffer-readtable* (guess-buffer-readtable buffer-package)) + (*pending-continuations* (cons id *pending-continuations*))) (assert (packagep *buffer-package*)) (assert (readtablep *buffer-readtable*)) (setq result (eval form)) @@ -1296,6 +1300,14 @@ (force-output) (format-values-for-echo-area values)))) +(defslimefun eval-and-grab-output (string) + (with-buffer-syntax () + (let* ((s (make-string-output-stream)) + (*standard-output* s) + (values (multiple-value-list (eval (read-from-string string))))) + (list (get-output-stream-string s) + (format nil "~{~S~^~%~}" values))))) + (defun eval-region (string &optional package-update-p) "Evaluate STRING and return the result. If PACKAGE-UPDATE-P is non-nil, and evaluation causes a package @@ -1325,10 +1337,13 @@ (defun canonical-package-nickname (package) "Return the canonical package nickname, if any, of PACKAGE." - (cdr (assoc (package-name package) *canonical-packge-nicknames* :test #'string=))) + (cdr (assoc (package-name package) *canonical-package-nicknames* + :test #'string=))) (defun auto-abbreviated-package-name (package) - "Return an abbreviated 'name' for PACKAGE. N.B. this is not an actual package name or nickname." + "Return an abbreviated 'name' for PACKAGE. + +N.B. this is not an actual package name or nickname." (when *auto-abbreviate-dotted-packages* (let ((last-dot (position #\. (package-name package) :from-end t))) (when last-dot (subseq (package-name package) (1+ last-dot)))))) @@ -1587,12 +1602,13 @@ (defslimefun debugger-info-for-emacs (start end) "Return debugger state, with stack frames from START to END. The result is a list: - (condition ({restart}*) ({stack-frame}*) + (condition ({restart}*) ({stack-frame}*) (cont*)) where condition ::= (description type [extra]) restart ::= (name description) stack-frame ::= (number description) - extra ::= (:references + extra ::= (:references and other random things) + cont ::= continutation condition---a pair of strings: message, and type. If show-source is not nil it is a frame number for which the source should be displayed. @@ -1601,6 +1617,8 @@ stack-frame---a number from zero (the top), and a printed representation of the frame's call. +continutation---the id of a pending Emacs continuation. + Below is an example return value. In this case the condition was a division by zero (multi-line description), and only one frame is being fetched (start=0, end=1). @@ -1610,10 +1628,12 @@ \"[Condition of type DIVISION-BY-ZERO]\") ((\"ABORT\" \"Return to Slime toplevel.\") (\"ABORT\" \"Return to Top-Level.\")) - ((0 \"(KERNEL::INTEGER-/-INTEGER 1 0)\")))" + ((0 \"(KERNEL::INTEGER-/-INTEGER 1 0)\")) + (4))" (list (debugger-condition-for-emacs) (format-restarts-for-emacs) - (backtrace start end))) + (backtrace start end) + *pending-continuations*)) (defun nth-restart (index) (nth index *sldb-restarts*)) From heller at common-lisp.net Thu Jan 27 19:56:26 2005 From: heller at common-lisp.net (Helmut Eller) Date: Thu, 27 Jan 2005 11:56:26 -0800 (PST) Subject: [slime-cvs] CVS update: slime/ChangeLog Message-ID: <20050127195626.318EB8802C@common-lisp.net> Update of /project/slime/cvsroot/slime In directory common-lisp.net:/tmp/cvs-serv23940 Modified Files: ChangeLog Log Message: *** empty log message *** Date: Thu Jan 27 11:56:23 2005 Author: heller Index: slime/ChangeLog diff -u slime/ChangeLog:1.604 slime/ChangeLog:1.605 --- slime/ChangeLog:1.604 Thu Jan 20 12:05:05 2005 +++ slime/ChangeLog Thu Jan 27 11:56:22 2005 @@ -1,3 +1,28 @@ +2005-01-27 Helmut Eller + + * slime.el (slime-busy-p): Ignore debugged continuations to enable + arglist lookup while debugging. Suggested by Lynn Quam. + (sldb-continuations): New buffer local variable in sldb buffers to + keep track of debugged continuations. + (sldb-debugged-continuations): New function. + (sldb-buffers): Renamed from sldb-remove-killed-buffers. + (slime-eval-print): New function to insert the stream output and + the result of an evaluation in the current buffer. + (slime-eval-print-last-expression): Use it. + (slime-interactive-eval): Use slime-eval-print when a prefix + argument was given. + + * swank.lisp (*pending-continuations*, eval-in-emacs) + (debugger-info-for-emacs): Keep track of debugged continuation the + new variable *pending-continuations* and include the list of + active continuations in the debugger info for Emacs. + (eval-and-grab-output): New function. Used by slime-eval-print. + (*log-output*): Renamed from *log-io*. Use *standard-error* as + initial value instead of *terminal-io*. CMUCL opens its own tty + and that makes it hard to redirect to output with a shell. + *standard-error* writes its output to file descriptor 2. + (*canonical-package-nicknames*): Fix typo. + 2005-01-20 Helmut Eller * swank.lisp (parse-symbol): Don't break if the package doesn't From heller at common-lisp.net Sun Jan 30 09:29:15 2005 From: heller at common-lisp.net (Helmut Eller) Date: Sun, 30 Jan 2005 01:29:15 -0800 (PST) Subject: [slime-cvs] CVS update: slime/slime.el Message-ID: <20050130092915.2DFD088029@common-lisp.net> Update of /project/slime/cvsroot/slime In directory common-lisp.net:/tmp/cvs-serv22220 Modified Files: slime.el Log Message: (slime-goto-location-position): Changed the regexp to require the function-name to be followed by a non-symbol-constituent character \S_. Previously a function-name of "find" will first match find-if-not if it occurs earlier in the file. Patch from Bryan O'Connor. Date: Sun Jan 30 01:29:15 2005 Author: heller Index: slime/slime.el diff -u slime/slime.el:1.453 slime/slime.el:1.454 --- slime/slime.el:1.453 Thu Jan 27 11:54:42 2005 +++ slime/slime.el Sun Jan 30 01:29:14 2005 @@ -3936,7 +3936,7 @@ (name (regexp-quote name))) (or (re-search-forward - (format "\\s *(def\\(\\s_\\|\\sw\\)*\\s +%s\\>" name) nil t) + (format "\\s *(def\\(\\s_\\|\\sw\\)*\\s +%s\\S_" name) nil t) (re-search-forward ;; FIXME: Isn't this far to general? (format "[( \t]%s\\>\\(\\s \\|$\\)" name) nil t))) From heller at common-lisp.net Sun Jan 30 09:29:43 2005 From: heller at common-lisp.net (Helmut Eller) Date: Sun, 30 Jan 2005 01:29:43 -0800 (PST) Subject: [slime-cvs] CVS update: slime/ChangeLog Message-ID: <20050130092943.021CE88029@common-lisp.net> Update of /project/slime/cvsroot/slime In directory common-lisp.net:/tmp/cvs-serv22260 Modified Files: ChangeLog Log Message: *** empty log message *** Date: Sun Jan 30 01:29:40 2005 Author: heller Index: slime/ChangeLog diff -u slime/ChangeLog:1.605 slime/ChangeLog:1.606 --- slime/ChangeLog:1.605 Thu Jan 27 11:56:22 2005 +++ slime/ChangeLog Sun Jan 30 01:29:38 2005 @@ -1,3 +1,11 @@ +2005-01-30 Bryan O'Connor + + * slime.el (slime-goto-location-position): Changed the regexp to + require the function-name to be followed by a + non-symbol-constituent character \S_. Previously a function-name + of "find" will first match find-if-not if it occurs earlier in the + file. + 2005-01-27 Helmut Eller * slime.el (slime-busy-p): Ignore debugged continuations to enable From heller at common-lisp.net Sun Jan 30 09:43:53 2005 From: heller at common-lisp.net (Helmut Eller) Date: Sun, 30 Jan 2005 01:43:53 -0800 (PST) Subject: [slime-cvs] CVS update: slime/ChangeLog Message-ID: <20050130094353.A144888029@common-lisp.net> Update of /project/slime/cvsroot/slime In directory common-lisp.net:/tmp/cvs-serv23044 Modified Files: ChangeLog Log Message: *** empty log message *** Date: Sun Jan 30 01:43:53 2005 Author: heller Index: slime/ChangeLog diff -u slime/ChangeLog:1.606 slime/ChangeLog:1.607 --- slime/ChangeLog:1.606 Sun Jan 30 01:29:38 2005 +++ slime/ChangeLog Sun Jan 30 01:43:52 2005 @@ -2,8 +2,8 @@ * slime.el (slime-goto-location-position): Changed the regexp to require the function-name to be followed by a - non-symbol-constituent character \S_. Previously a function-name - of "find" will first match find-if-not if it occurs earlier in the + non-symbol-constituent character \S_. Previously, a function-name + of "find" first matched find-if-not if it occured earlier in the file. 2005-01-27 Helmut Eller