From Deandre99180 at xd990.net Tue Jun 8 20:31:53 2004 From: Deandre99180 at xd990.net (Ulberto Kenning) Date: Tue, 08 Jun 2004 22:31:53 +0200 Subject: [slime-cvs] Fwd: please Message-ID: An HTML attachment was scrubbed... URL: From lgorrie at common-lisp.net Tue Jun 8 20:32:50 2004 From: lgorrie at common-lisp.net (Luke Gorrie) Date: Tue, 08 Jun 2004 13:32:50 -0700 Subject: [slime-cvs] CVS update: slime/swank-sbcl.lisp slime/swank-cmucl.lisp Message-ID: Update of /project/slime/cvsroot/slime In directory common-lisp.net:/tmp/cvs-serv5390 Modified Files: swank-sbcl.lisp swank-cmucl.lisp Log Message: (close-socket): Remove any SERVE-EVENT handlers for the socket's file descriptor. Date: Tue Jun 8 13:32:50 2004 Author: lgorrie Index: slime/swank-sbcl.lisp diff -u slime/swank-sbcl.lisp:1.85 slime/swank-sbcl.lisp:1.86 --- slime/swank-sbcl.lisp:1.85 Tue May 11 13:58:46 2004 +++ slime/swank-sbcl.lisp Tue Jun 8 13:32:50 2004 @@ -63,6 +63,7 @@ (nth-value 1 (sb-bsd-sockets:socket-name socket))) (defimplementation close-socket (socket) + (sb-sys:invalidate-descriptor (socket-fd socket)) (sb-bsd-sockets:socket-close socket)) (defimplementation accept-connection (socket) Index: slime/swank-cmucl.lisp diff -u slime/swank-cmucl.lisp:1.105 slime/swank-cmucl.lisp:1.106 --- slime/swank-cmucl.lisp:1.105 Mon Jun 7 11:37:54 2004 +++ slime/swank-cmucl.lisp Tue Jun 8 13:32:50 2004 @@ -78,6 +78,7 @@ (nth-value 1 (ext::get-socket-host-and-port (socket-fd socket)))) (defimplementation close-socket (socket) + (sys:invalidate-descriptor socket) (ext:close-socket (socket-fd socket))) (defimplementation accept-connection (socket) From lgorrie at common-lisp.net Tue Jun 8 20:33:10 2004 From: lgorrie at common-lisp.net (Luke Gorrie) Date: Tue, 08 Jun 2004 13:33:10 -0700 Subject: [slime-cvs] CVS update: slime/ChangeLog Message-ID: Update of /project/slime/cvsroot/slime In directory common-lisp.net:/tmp/cvs-serv5686 Modified Files: ChangeLog Log Message: Date: Tue Jun 8 13:33:10 2004 Author: lgorrie Index: slime/ChangeLog diff -u slime/ChangeLog:1.385 slime/ChangeLog:1.386 --- slime/ChangeLog:1.385 Mon Jun 7 11:38:02 2004 +++ slime/ChangeLog Tue Jun 8 13:33:10 2004 @@ -1,3 +1,10 @@ +2004-06-08 Luke Gorrie + + * swank-cmucl.lisp (close-socket): Remove any SERVE-EVENT handlers + for the socket's file descriptor. + + * swank-sbcl.lisp (close-socket): Same fix. + 2004-06-07 Luke Gorrie * swank-cmucl.lisp: Minor refactorings. From lgorrie at common-lisp.net Tue Jun 8 23:57:19 2004 From: lgorrie at common-lisp.net (Luke Gorrie) Date: Tue, 08 Jun 2004 16:57:19 -0700 Subject: [slime-cvs] CVS update: slime/swank-backend.lisp Message-ID: Update of /project/slime/cvsroot/slime In directory common-lisp.net:/tmp/cvs-serv31268 Modified Files: swank-backend.lisp Log Message: (format-sldb-condition): New backend function to format conditions for SLDB. (condition-references): New function to return a list of documentation references associated with a condition. Date: Tue Jun 8 16:57:19 2004 Author: lgorrie Index: slime/swank-backend.lisp diff -u slime/swank-backend.lisp:1.48 slime/swank-backend.lisp:1.49 --- slime/swank-backend.lisp:1.48 Mon Jun 7 11:27:30 2004 +++ slime/swank-backend.lisp Tue Jun 8 16:57:19 2004 @@ -366,6 +366,19 @@ "Restart execution of the frame FRAME-NUMBER with the same arguments as it was called originally.") +(definterface format-sldb-condition (condition) + "Format a condition for display in SLDB." + (princ-to-string condition)) + +(definterface condition-references (condition) + "Return a list of documentation references for a condition. +Each reference is one of: + (:ANSI-CL + {:FUNCTION | :SPECIAL-OPERATOR | :MACRO | :SECTION | :GLOSSARY } + symbol-or-name) + (:SBCL :NODE node-name)" + '()) + ;;;; Definition finding From lgorrie at common-lisp.net Tue Jun 8 23:57:35 2004 From: lgorrie at common-lisp.net (Luke Gorrie) Date: Tue, 08 Jun 2004 16:57:35 -0700 Subject: [slime-cvs] CVS update: slime/swank-sbcl.lisp Message-ID: Update of /project/slime/cvsroot/slime In directory common-lisp.net:/tmp/cvs-serv31485 Modified Files: swank-sbcl.lisp Log Message: (format-sldb-condition, condition-references): Implemented. Requires a recent (latest?) SBCL release. Date: Tue Jun 8 16:57:35 2004 Author: lgorrie Index: slime/swank-sbcl.lisp diff -u slime/swank-sbcl.lisp:1.86 slime/swank-sbcl.lisp:1.87 --- slime/swank-sbcl.lisp:1.86 Tue Jun 8 13:32:50 2004 +++ slime/swank-sbcl.lisp Tue Jun 8 16:57:35 2004 @@ -524,6 +524,17 @@ (cond (probe (throw (car probe) (eval-in-frame form index))) (t (format nil "Cannot return from frame: ~S" frame))))) +;;;;; reference-conditions + +(defimplementation format-sldb-condition (condition) + (let ((sb-int:*print-condition-references* nil)) + (princ-to-string condition))) + +(defimplementation condition-references (condition) + (if (typep condition 'sb-int:reference-condition) + (sb-int:reference-condition-references condition) + '())) + ;;;; Profiling From lgorrie at common-lisp.net Tue Jun 8 23:57:57 2004 From: lgorrie at common-lisp.net (Luke Gorrie) Date: Tue, 08 Jun 2004 16:57:57 -0700 Subject: [slime-cvs] CVS update: slime/swank.lisp Message-ID: Update of /project/slime/cvsroot/slime In directory common-lisp.net:/tmp/cvs-serv31580 Modified Files: swank.lisp Log Message: (debugger-condition-for-emacs): Call new backend functions to add a `references' list for Emacs. Date: Tue Jun 8 16:57:57 2004 Author: lgorrie Index: slime/swank.lisp diff -u slime/swank.lisp:1.187 slime/swank.lisp:1.188 --- slime/swank.lisp:1.187 Mon Jun 7 11:27:30 2004 +++ slime/swank.lisp Tue Jun 8 16:57:57 2004 @@ -972,7 +972,7 @@ printing." (let ((*print-pretty* t)) (handler-case - (princ-to-string condition) + (format-sldb-condition condition) (error (cond) ;; Beware of recursive errors in printing, so only use the condition ;; if it is printable itself: @@ -982,7 +982,8 @@ (defun debugger-condition-for-emacs () (list (safe-condition-message *swank-debugger-condition*) (format nil " [Condition of type ~S]" - (type-of *swank-debugger-condition*)))) + (type-of *swank-debugger-condition*)) + (condition-references *swank-debugger-condition*))) (defun format-restarts-for-emacs () "Return a list of restarts for *swank-debugger-condition* in a From lgorrie at common-lisp.net Tue Jun 8 23:58:09 2004 From: lgorrie at common-lisp.net (Luke Gorrie) Date: Tue, 08 Jun 2004 16:58:09 -0700 Subject: [slime-cvs] CVS update: slime/slime.el Message-ID: Update of /project/slime/cvsroot/slime In directory common-lisp.net:/tmp/cvs-serv31839 Modified Files: slime.el Log Message: (sldb-insert-references): Added support for hyperlinked references as part of conditions being debugged. This is a new feature in SBCL to reference appropriate sections of their manual or CLHS from condition objects. The references are clickable. Date: Tue Jun 8 16:58:09 2004 Author: lgorrie Index: slime/slime.el diff -u slime/slime.el:1.308 slime/slime.el:1.309 --- slime/slime.el:1.308 Mon May 24 18:31:53 2004 +++ slime/slime.el Tue Jun 8 16:58:09 2004 @@ -135,6 +135,9 @@ (defvar slime-kill-without-query-p t "If non-nil, kill Slime processes without query when quitting Emacs.") +(defvar slime-sbcl-manual-root "http://www.sbcl.org/manual/" + "*The base URL of the SBCL manual, for documentation lookup.") + ;;; Customize group @@ -295,6 +298,8 @@ (def-sldb-face local-name "label for local variable") (def-sldb-face local-value "local variable values") (def-sldb-face catch-tag "catch tags") +(def-sldb-face reference "documentation reference" + (:underline t)) (defcustom slime-compilation-finished-hook 'slime-maybe-list-compiler-notes "Hook called with a list of compiler notes after a compilation." @@ -1028,6 +1033,16 @@ (when (buffer-live-p (get-buffer buffer-name)) (kill-buffer buffer-name))) +(defmacro slime-with-rigid-indentation (level &rest body) + "Execute BODY and then rigidly indent its text insertions. +Assumes all insertions are made at point." + (let ((start (gensym))) + `(let ((,start (point))) + (prog1 (progn , at body) + (indent-rigidly ,start (point) ,level))))) + +(put 'slime-with-rigid-indentation 'lisp-indent-function 1) + ;;; Inferior CL Setup: compiling and connecting to Swank @@ -4765,13 +4780,6 @@ (funcall (if create #'get-buffer-create #'get-buffer) buffer-name))) -(defun sldb-insert-condition (condition) - (destructuring-bind (message type) condition - (insert (in-sldb-face topline message) - "\n" - (in-sldb-face condition type) - "\n\n"))) - (defun sldb-setup (thread level condition restarts frames) "Setup a new SLDB buffer. CONDITION is a string describing the condition to debug. @@ -4820,6 +4828,66 @@ (setq sldb-level nil)) (when (= level 1) (kill-buffer sldb)))) + +(defun sldb-insert-condition (condition) + (destructuring-bind (message type references) condition + (insert (in-sldb-face topline message) + "\n" + (in-sldb-face condition type) + "\n\n") + (when references + (insert "See also:\n") + (slime-with-rigid-indentation 2 + (sldb-insert-references references)) + (insert "\n")))) + +(defun sldb-insert-references (references) + "Insert documentation references from a condition. +See SWANK-BACKEND:CONDITION-REFERENCES for the datatype." + (loop for ref in references + do + (destructuring-bind (where type what) ref + (insert (sldb-format-reference-source where) ", ") + (slime-insert-propertized (sldb-reference-properties where type what) + (sldb-format-reference-node what)) + (insert (format " [%s]" (slime-cl-symbol-name type)) "\n")))) + +(defun sldb-reference-properties (where type what) + "Return the properties for a reference. +Only add clickability to properties we actually know how to lookup." + (if (or (and (eq where :sbcl) (eq type :node)) + (and (eq where :ansi-cl) + (symbolp type) + (member (slime-cl-symbol-name type) + '("function" "special-operator" "macro")))) + `(sldb-default-action sldb-lookup-reference + sldb-reference ,ref + face sldb-reference-face + mouse-face highlight))) + +(defun sldb-format-reference-source (where) + (case where + (:ansi-cl "Common Lisp Hyperspec") + (:sbcl "SBCL Manual") + (t (format "%S" where)))) + +(defun sldb-format-reference-node (what) + (if (symbolp what) + (upcase (slime-cl-symbol-name what)) + what)) + +(defun sldb-lookup-reference () + "Browse the documentation reference at point." + (destructuring-bind (where type what) + (get-text-property (point) 'sldb-reference) + (case where + (:ansi-cl + (hyperspec-lookup (if (symbolp what) + (slime-cl-symbol-name what) + what))) + (t + (let ((url (format "%s%s.html" slime-sbcl-manual-root (downcase what)))) + (browse-url url)))))) (defun sldb-insert-restarts (restarts) (loop for (name string) in restarts From lgorrie at common-lisp.net Tue Jun 8 23:58:32 2004 From: lgorrie at common-lisp.net (Luke Gorrie) Date: Tue, 08 Jun 2004 16:58:32 -0700 Subject: [slime-cvs] CVS update: slime/ChangeLog Message-ID: Update of /project/slime/cvsroot/slime In directory common-lisp.net:/tmp/cvs-serv32576 Modified Files: ChangeLog Log Message: Date: Tue Jun 8 16:58:32 2004 Author: lgorrie Index: slime/ChangeLog diff -u slime/ChangeLog:1.386 slime/ChangeLog:1.387 --- slime/ChangeLog:1.386 Tue Jun 8 13:33:10 2004 +++ slime/ChangeLog Tue Jun 8 16:58:32 2004 @@ -1,3 +1,21 @@ +2004-06-09 Luke Gorrie + + * slime.el (sldb-insert-references): Added support for hyperlinked + references as part of conditions being debugged. This is a new + feature in SBCL to reference appropriate sections of their manual + or CLHS from condition objects. The references are clickable. + + * swank-backend.lisp (format-sldb-condition): New backend function + to format conditions for SLDB. + (condition-references): New function to return a list of + documentation references associated with a condition. + + * swank.lisp (debugger-condition-for-emacs): Call the above + backend functions to add a `references' list for Emacs. + + * swank-sbcl.lisp (format-sldb-condition, condition-references): + Implemented. Requires a recent (latest?) SBCL release. + 2004-06-08 Luke Gorrie * swank-cmucl.lisp (close-socket): Remove any SERVE-EVENT handlers From xzoah at msn.com Wed Jun 9 03:42:32 2004 From: xzoah at msn.com (Mel Rice) Date: Wed, 09 Jun 2004 09:42:32 +0600 Subject: [slime-cvs] L0se Wei*ght Now with Ph*entermine, Adi*pex, B0ntril, Pr*escribed 0nline, sh*ipped t0 Y0ur D00r captor applicate circle chauncey cease afar declassify agglutinate game achieve chinamen difficulty barr humanoid squibb crayfish persecutory disparate fiddle imperate bstj seventieth lying bong blanchard glint pentagon route mare parley uppercut patriot compost concessionaire backboard Message-ID: <2765711527158.65193@xzoah@msn.com> An HTML attachment was scrubbed... URL: From ivbrl at msn.com Wed Jun 9 08:20:32 2004 From: ivbrl at msn.com (Damon Stephens) Date: Wed, 09 Jun 2004 12:20:32 +0400 Subject: [slime-cvs] Va*lium, Xa*nax, cial*is, Vi*agra, lev*itra, S*oma, Fi*oricet, Pre*scribed Online for Freee, Shi*pped Overn*ight cretaceous caucasian abram honest level ardent cutout quarryman glacis authenticate feint cf antipodes bulletin chilblain frenzy spear nouveau Message-ID: <3779208375191.45052@ivbrl@msn.com> An HTML attachment was scrubbed... URL: From msimmons at common-lisp.net Wed Jun 9 12:35:23 2004 From: msimmons at common-lisp.net (Martin Simmons) Date: Wed, 09 Jun 2004 05:35:23 -0700 Subject: [slime-cvs] CVS update: slime/swank-backend.lisp Message-ID: Update of /project/slime/cvsroot/slime In directory common-lisp.net:/tmp/cvs-serv19346 Modified Files: swank-backend.lisp Log Message: (network-error): Inherit from simple-error to get correct initargs. Date: Wed Jun 9 05:35:22 2004 Author: msimmons Index: slime/swank-backend.lisp diff -u slime/swank-backend.lisp:1.49 slime/swank-backend.lisp:1.50 --- slime/swank-backend.lisp:1.49 Tue Jun 8 16:57:19 2004 +++ slime/swank-backend.lisp Wed Jun 9 05:35:22 2004 @@ -131,7 +131,7 @@ nil) ;;; Base condition for networking errors. -(define-condition network-error (error) ()) +(define-condition network-error (simple-error) ()) (definterface emacs-connected () "Hook called when the first connection from Emacs is established. From msimmons at common-lisp.net Wed Jun 9 12:40:53 2004 From: msimmons at common-lisp.net (Martin Simmons) Date: Wed, 09 Jun 2004 05:40:53 -0700 Subject: [slime-cvs] CVS update: slime/swank-lispworks.lisp Message-ID: Update of /project/slime/cvsroot/slime In directory common-lisp.net:/tmp/cvs-serv28507 Modified Files: swank-lispworks.lisp Log Message: (dspec-stream-position): New function to make source location work for anything complicated e.g. methods. (with-swank-compilation-unit): Refactoring. (who-macroexpands): Implemented. (list-callers): Implemented. Date: Wed Jun 9 05:40:52 2004 Author: msimmons Index: slime/swank-lispworks.lisp diff -u slime/swank-lispworks.lisp:1.41 slime/swank-lispworks.lisp:1.42 --- slime/swank-lispworks.lisp:1.41 Sat May 1 09:37:43 2004 +++ slime/swank-lispworks.lisp Wed Jun 9 05:40:52 2004 @@ -291,12 +291,17 @@ ;;; Compilation +(defmacro with-swank-compilation-unit ((location &rest options) &body body) + (lw:rebinding (location) + `(let ((compiler::*error-database* '())) + (with-compilation-unit ,options + , at body + (signal-error-data-base compiler::*error-database* ,location) + (signal-undefined-functions compiler::*unknown-functions* ,location))))) + (defimplementation swank-compile-file (filename load-p) - (let ((compiler::*error-database* '())) - (with-compilation-unit () - (compile-file filename :load load-p) - (signal-error-data-base compiler::*error-database* filename) - (signal-undefined-functions compiler::*unknown-functions* filename)))) + (with-swank-compilation-unit (filename) + (compile-file filename :load load-p))) (defun map-error-database (database fn) (loop for (filename . defs) in database do @@ -340,6 +345,34 @@ (null (list :position offset)) (symbol (list :function-name (string dspec))))) +#-(or lispworks-4.1 lispworks-4.2) ; no dspec:parse-form-dspec prior to 4.3 +(defun dspec-stream-position (stream dspec) + (with-standard-io-syntax + (let ((*read-eval* nil)) + (loop (let* ((pos (file-position stream)) + (form (read stream nil '#1=#:eof))) + (when (eq form '#1#) + (return nil)) + (labels ((check-dspec (form) + (when (consp form) + (let ((operator (car form))) + (case operator + ((progn) + (mapcar #'check-dspec + (cdr form))) + ((eval-when locally macrolet symbol-macrolet) + (mapcar #'check-dspec + (cddr form))) + ((in-package) + (let ((package (find-package (second form)))) + (when package + (setq *package* package)))) + (otherwise + (let ((form-dspec (dspec:parse-form-dspec form))) + (when (dspec:dspec-equal dspec form-dspec) + (return pos))))))))) + (check-dspec form))))))) + (defun emacs-buffer-location-p (location) (and (consp location) (eq (car location) :emacs-buffer))) @@ -357,9 +390,17 @@ (symbol (symbol-name dspec)) (cons (string (dspec:dspec-primary-name dspec)))))) (etypecase location - ((or pathname string) - (make-location `(:file ,(filename location)) - (dspec-buffer-position dspec 1))) + ((or pathname string) + (let ((checked-filename (filename location))) + (make-location `(:file ,checked-filename) + #+(or lispworks-4.1 lispworks-4.2) + (dspec-buffer-position dspec 1) + #-(or lispworks-4.1 lispworks-4.2) + (with-open-file (stream checked-filename) + (let ((position (dspec-stream-position stream dspec))) + (if position + (list :position (1+ position) t) + (dspec-buffer-position dspec 1))))))) (symbol `(:error ,(format nil "Cannot resolve location: ~S" location))) ((satisfies emacs-buffer-location-p) (destructuring-bind (_ buffer offset string) location @@ -367,6 +408,16 @@ (make-location `(:buffer ,buffer) (dspec-buffer-position dspec offset))))))) +(defun make-dspec-progenitor-location (dspec location) + (let ((canon-dspec (dspec:canonicalize-dspec dspec))) + (make-dspec-location + (if canon-dspec + (if (dspec:local-dspec-p canon-dspec) + (dspec:dspec-progenitor canon-dspec) + canon-dspec) + nil) + location))) + (defun signal-error-data-base (database location) (map-error-database database @@ -374,7 +425,7 @@ (declare (ignore filename)) (signal-compiler-condition (format nil "~A" condition) - (make-dspec-location dspec location) + (make-dspec-progenitor-location dspec location) condition)))) (defun signal-undefined-functions (htab filename) @@ -382,7 +433,7 @@ (dolist (dspec dspecs) (signal-compiler-condition (format nil "Undefined function ~A" unfun) - (make-dspec-location dspec filename) + (make-dspec-progenitor-location dspec filename) nil))) htab)) @@ -390,16 +441,13 @@ (assert buffer) (assert position) (let* ((location (list :emacs-buffer buffer position string)) - (compiler::*error-database* '()) (tmpname (hcl:make-temp-file nil "lisp"))) - (with-compilation-unit () + (with-swank-compilation-unit (location) (compile-from-temp-file (format nil "~S~%~A" `(eval-when (:compile-toplevel) (setq dspec::*location* (list , at location))) string) - tmpname) - (signal-error-data-base compiler::*error-database* location) - (signal-undefined-functions compiler::*unknown-functions* location)))) + tmpname)))) ;;; xref @@ -408,7 +456,26 @@ (xref-results (,function name)))) (defxref who-calls hcl:who-calls) +(defxref who-macroexpands hcl:who-calls) ; macros are in the calls table too (defxref list-callees hcl:calls-who) +(defxref list-callers list-callers-internal) + +(defun list-callers-internal (name) + (let ((callers (make-array 100 + :fill-pointer 0 + :adjustable t))) + (hcl:sweep-all-objects + #'(lambda (object) + (when (and #+Harlequin-PC-Lisp (low:compiled-code-p object) + #-Harlequin-PC-Lisp (sys::callablep object) + (system::find-constant$funcallable name object)) + (vector-push-extend object callers)))) + ;; Delay dspec:object-dspec until after sweep-all-objects + ;; to reduce allocation problems. + (loop for object across callers + collect (if (symbolp object) + (list 'function object) + (dspec:object-dspec object))))) ;; only for lispworks 4.2 and above #-lispworks4.1 From msimmons at common-lisp.net Wed Jun 9 12:41:43 2004 From: msimmons at common-lisp.net (Martin Simmons) Date: Wed, 09 Jun 2004 05:41:43 -0700 Subject: [slime-cvs] CVS update: slime/ChangeLog Message-ID: Update of /project/slime/cvsroot/slime In directory common-lisp.net:/tmp/cvs-serv13388 Modified Files: ChangeLog Log Message: Date: Wed Jun 9 05:41:43 2004 Author: msimmons Index: slime/ChangeLog diff -u slime/ChangeLog:1.387 slime/ChangeLog:1.388 --- slime/ChangeLog:1.387 Tue Jun 8 16:58:32 2004 +++ slime/ChangeLog Wed Jun 9 05:41:43 2004 @@ -1,3 +1,14 @@ +2004-06-09 Martin Simmons + + * swank-lispworks.lisp (dspec-stream-position): New function to + make source location work for anything complicated e.g. methods. + (with-swank-compilation-unit): Refactoring. + (who-macroexpands): Implemented. + (list-callers): Implemented. + + * swank-backend.lisp (network-error): Inherit from simple-error to + get correct initargs. + 2004-06-09 Luke Gorrie * slime.el (sldb-insert-references): Added support for hyperlinked From coliformvdyl at zionsbank.com Wed Jun 9 13:31:31 2004 From: coliformvdyl at zionsbank.com (Christopher Holman) Date: Wed, 09 Jun 2004 08:31:31 -0500 Subject: [slime-cvs] RE: Mo[r]tgage Application Message-ID: An HTML attachment was scrubbed... URL: From CLJTPOI at hotmail.com Wed Jun 9 15:13:33 2004 From: CLJTPOI at hotmail.com (Maude Mcgowan) Date: Wed, 09 Jun 2004 18:13:33 +0300 Subject: [slime-cvs] Damn just saw my wife getiing fucked Message-ID: An HTML attachment was scrubbed... URL: From heller at common-lisp.net Wed Jun 9 20:08:16 2004 From: heller at common-lisp.net (Helmut Eller) Date: Wed, 09 Jun 2004 13:08:16 -0700 Subject: [slime-cvs] CVS update: slime/swank-abcl.lisp Message-ID: Update of /project/slime/cvsroot/slime In directory common-lisp.net:/tmp/cvs-serv14040 Added Files: swank-abcl.lisp Log Message: ABCL backend from Andras Simon. Date: Wed Jun 9 13:08:16 2004 Author: heller From heller at common-lisp.net Wed Jun 9 20:08:39 2004 From: heller at common-lisp.net (Helmut Eller) Date: Wed, 09 Jun 2004 13:08:39 -0700 Subject: [slime-cvs] CVS update: slime/swank-loader.lisp Message-ID: Update of /project/slime/cvsroot/slime In directory common-lisp.net:/tmp/cvs-serv16479 Modified Files: swank-loader.lisp Log Message: Add ABCL support. Date: Wed Jun 9 13:08:39 2004 Author: heller Index: slime/swank-loader.lisp diff -u slime/swank-loader.lisp:1.23 slime/swank-loader.lisp:1.24 --- slime/swank-loader.lisp:1.23 Wed Apr 28 15:21:10 2004 +++ slime/swank-loader.lisp Wed Jun 9 13:08:39 2004 @@ -37,6 +37,7 @@ #+lispworks '("swank-lispworks" "swank-gray") #+allegro '("swank-allegro" "swank-gray") #+clisp '("xref" "metering" "swank-clisp" "swank-gray") + #+armedbear '("swank-abcl" "swank-gray") ))) (defparameter *lisp-name* @@ -47,6 +48,7 @@ #+allegro "allegro" #+clisp (format nil "clisp-~A" (let ((s (lisp-implementation-version))) (subseq s 0 (position #\space s)))) + #+armedbear "abcl" ) (defparameter *swank-pathname* (make-swank-pathname "swank")) @@ -92,6 +94,7 @@ #-mswindows (make-pathname :name ".swank" :type "lisp") #+mswindows (make-pathname :name "_swank" :type "lsp")))) + (compile-files-if-needed-serially (append (list (make-swank-pathname "swank-backend")) *sysdep-pathnames* From heller at common-lisp.net Wed Jun 9 20:17:56 2004 From: heller at common-lisp.net (Helmut Eller) Date: Wed, 09 Jun 2004 13:17:56 -0700 Subject: [slime-cvs] CVS update: slime/slime.el Message-ID: Update of /project/slime/cvsroot/slime In directory common-lisp.net:/tmp/cvs-serv6377 Modified Files: slime.el Log Message: (slime-indent-and-complete-symbol): Renamed from slime-repl-indent-and-complete-symbol. From Eric Blood. (slime-init-output-buffer): Initialize the package stack. Reported by Rui Patroc?nio. (slime-completions): Make it consistent with slime-simple-completions. The second argument was never supplied. Reported by Rui Patroc?nio. (slime-typeout-frame-properties): Add more default options for the typeout frame--specifically it now has a default width, and moves the typeout frame to the upper right. From Eric Blood. (slime-goto-location-position) [:function-name]: The function name can also occur after a ?(, not only after whitespace. Date: Wed Jun 9 13:17:55 2004 Author: heller Index: slime/slime.el diff -u slime/slime.el:1.309 slime/slime.el:1.310 --- slime/slime.el:1.309 Tue Jun 8 16:58:09 2004 +++ slime/slime.el Wed Jun 9 13:17:55 2004 @@ -1033,6 +1033,18 @@ (when (buffer-live-p (get-buffer buffer-name)) (kill-buffer buffer-name))) +(defun slime-indent-and-complete-symbol () + "Indent the current line and perform symbol completion. +First indent the line; if indenting doesn't move point, complete the +symbol." + (interactive) + (let ((pos (point))) + (lisp-indent-line) + (when (and (= pos (point)) + (save-excursion + (re-search-backward "[^ \n\t\r]+\\=" nil t))) + (slime-complete-symbol)))) + (defmacro slime-with-rigid-indentation (level &rest body) "Execute BODY and then rigidly indent its text insertions. Assumes all insertions are made at point." @@ -1683,7 +1695,7 @@ (defun slime-set-connection-info (connection info) "Initialize CONNECTION with INFO received from Lisp." (destructuring-bind (version pid type name features) info -;; (slime-check-protocol-version version) +;;; (slime-check-protocol-version version) (setf (slime-pid) pid (slime-lisp-implementation-type) type (slime-lisp-implementation-type-name) name @@ -1924,6 +1936,7 @@ ;; set the directory stack (setq slime-repl-directory-stack (list (expand-file-name default-directory))) + (setq slime-repl-package-stack (list (slime-lisp-package))) (slime-repl-update-banner))) (defvar slime-show-last-output-function @@ -1971,7 +1984,7 @@ `(progn (cond ((= (point) slime-output-end) (let ((start (point))) - ;; XXX Assertion is currently easy to break, by type + ;; 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 @@ -2330,18 +2343,6 @@ (insert "\n") (lisp-indent-line))) -(defun slime-repl-indent-and-complete-symbol () - "Indent the current line and perform symbol completion. -First indent the line. If indenting doesn't move point complete the -symbol." - (interactive) - (let ((pos (point))) - (lisp-indent-line) - (when (and (= pos (point)) - (save-excursion - (re-search-backward "\\(\\s_\\|\\sw\\)+\\=" nil t))) - (slime-complete-symbol)))) - (defun slime-repl-delete-current-input () (delete-region slime-repl-input-start-mark slime-repl-input-end-mark)) @@ -2490,7 +2491,7 @@ ("\C-c:" 'slime-interactive-eval) ("\C-c\C-e" 'slime-interactive-eval) ;("\t" 'slime-complete-symbol) - ("\t" 'slime-repl-indent-and-complete-symbol) + ("\t" 'slime-indent-and-complete-symbol) (" " 'slime-space) ("\C-\M-x" 'slime-eval-defun) ("\C-c\C-o" 'slime-repl-clear-output) @@ -3166,7 +3167,7 @@ (re-search-forward (format "\\s *(def\\(\\s_\\|\\sw\\)*\\s +%s\\>" name) nil t) (re-search-forward - (format "\\s %s\\>\\(\\s \\|$\\)" name) nil t))) + (format "[( \t]%s\\>\\(\\s \\|$\\)" name) nil t))) (goto-char (match-beginning 0))) ((:source-path source-path start-position) (cond (start-position @@ -3565,7 +3566,8 @@ "The current typeout window.") (defvar slime-typeout-frame-properties - '((height . 16) (minibuffer . nil) (name . "SLIME Typeout")) + '((width . 40) (height . 10) (minibuffer . nil) + (left . -10) (top . 10) (name . "SLIME Typeout")) "The typeout frame properties (passed to `make-frame').") (defun slime-typeout-active-p () @@ -3637,7 +3639,7 @@ (slime-complete-restore-window-configuration)) ((memq this-command '(self-insert-command slime-complete-symbol - slime-repl-indent-and-complete-symbol + slime-indent-and-complete-symbol backward-delete-char-untabify backward-delete-char scroll-other-window)) @@ -3781,20 +3783,15 @@ alist but ignores CDRs." (mapcar (lambda (x) (cons x nil)) list)) -(defun slime-completions (prefix &optional default-package) - (let ((prefix (etypecase prefix - (symbol (symbol-name prefix)) - (string prefix)))) - (slime-eval `(swank:completions ,prefix - ,(or default-package - (slime-find-buffer-package) - (slime-buffer-package)))))) +(defun slime-completions (prefix) + (slime-eval `(swank:completions ,prefix + ,(or (slime-find-buffer-package) + (slime-buffer-package))))) (defun slime-simple-completions (prefix) - (slime-eval `(swank:simple-completions - ,prefix - ,(or (slime-find-buffer-package) - (slime-buffer-package))))) + (slime-eval `(swank:simple-completions ,prefix + ,(or (slime-find-buffer-package) + (slime-buffer-package))))) ;;; Interpreting Elisp symbols as CL symbols (package qualifiers) From heller at common-lisp.net Wed Jun 9 20:24:15 2004 From: heller at common-lisp.net (Helmut Eller) Date: Wed, 09 Jun 2004 13:24:15 -0700 Subject: [slime-cvs] CVS update: slime/ChangeLog Message-ID: Update of /project/slime/cvsroot/slime In directory common-lisp.net:/tmp/cvs-serv24654 Modified Files: ChangeLog Log Message: *** empty log message *** Date: Wed Jun 9 13:24:15 2004 Author: heller Index: slime/ChangeLog diff -u slime/ChangeLog:1.388 slime/ChangeLog:1.389 --- slime/ChangeLog:1.388 Wed Jun 9 05:41:43 2004 +++ slime/ChangeLog Wed Jun 9 13:24:15 2004 @@ -1,3 +1,31 @@ +2004-06-09 Helmut Eller + + * slime.el (slime-goto-location-position) [:function-name]: The + function name can also occur after a ?(, not only after + whitespace. + + * (slime-init-output-buffer): Initialize the package stack. + Reported by Rui Patroc?nio. + + * (slime-completions): Make it consistent with + slime-simple-completions. The second argument was never supplied. + Reported by Rui Patroc?nio. + +2004-06-09 Eric Blood + + * slime.el (slime-indent-and-complete-symbol): Renamed from + slime-repl-indent-and-complete-symbol. + + (slime-typeout-frame-properties): Add more default options for the + typeout frame--specifically it now has a default width, and moves + the typeout frame to the upper right. + +2004-06-09 Andras Simon + + * swank-abcl.lisp: New backend for Armed Bear Common Lisp. + + * swank-loader.lisp: Add ABCL support. + 2004-06-09 Martin Simmons * swank-lispworks.lisp (dspec-stream-position): New function to From lgorrie at common-lisp.net Thu Jun 10 04:40:22 2004 From: lgorrie at common-lisp.net (Luke Gorrie) Date: Wed, 09 Jun 2004 21:40:22 -0700 Subject: [slime-cvs] CVS update: slime/slime.el Message-ID: Update of /project/slime/cvsroot/slime In directory common-lisp.net:/tmp/cvs-serv3254 Modified Files: slime.el Log Message: (sldb-step): Command is disabled because the function `swank:sldb-step' that it calls doesn't exist. I don't see any stepping code in our backends. Date: Wed Jun 9 21:40:22 2004 Author: lgorrie Index: slime/slime.el diff -u slime/slime.el:1.310 slime/slime.el:1.311 --- slime/slime.el:1.310 Wed Jun 9 13:17:55 2004 +++ slime/slime.el Wed Jun 9 21:40:22 2004 @@ -5252,6 +5252,8 @@ (defun sldb-step () "Select the \"continue\" restart and set a new break point." (interactive) + ;; FIXME + (error "Not implemented.") (let ((frame (sldb-frame-number-at-point))) (slime-eval-async `(swank:sldb-step ,frame) nil (lambda ())))) From lgorrie at common-lisp.net Thu Jun 10 04:40:28 2004 From: lgorrie at common-lisp.net (Luke Gorrie) Date: Wed, 09 Jun 2004 21:40:28 -0700 Subject: [slime-cvs] CVS update: slime/ChangeLog Message-ID: Update of /project/slime/cvsroot/slime In directory common-lisp.net:/tmp/cvs-serv3416 Modified Files: ChangeLog Log Message: Date: Wed Jun 9 21:40:28 2004 Author: lgorrie Index: slime/ChangeLog diff -u slime/ChangeLog:1.389 slime/ChangeLog:1.390 --- slime/ChangeLog:1.389 Wed Jun 9 13:24:15 2004 +++ slime/ChangeLog Wed Jun 9 21:40:28 2004 @@ -1,3 +1,9 @@ +2004-06-10 Luke Gorrie + + * slime.el (sldb-step): Command is disabled because the function + `swank:sldb-step' that it calls doesn't exist. I don't see any + stepping code in our backends. + 2004-06-09 Helmut Eller * slime.el (slime-goto-location-position) [:function-name]: The From fundraisexqe at mminternet.com Thu Jun 10 07:42:32 2004 From: fundraisexqe at mminternet.com (Kathy Johns) Date: Thu, 10 Jun 2004 02:42:32 -0500 Subject: [slime-cvs] Congrats, You Qualify for our program Message-ID: An HTML attachment was scrubbed... URL: From heller at common-lisp.net Thu Jun 10 17:34:07 2004 From: heller at common-lisp.net (Helmut Eller) Date: Thu, 10 Jun 2004 10:34:07 -0700 Subject: [slime-cvs] CVS update: slime/slime.el Message-ID: Update of /project/slime/cvsroot/slime In directory common-lisp.net:/tmp/cvs-serv3857 Modified Files: slime.el Log Message: (pwd): Re-add REPL shortcut. (slime-repl-push-directory, slime-repl-compile-and-load): Simplified. Date: Thu Jun 10 10:34:07 2004 Author: heller Index: slime/slime.el diff -u slime/slime.el:1.311 slime/slime.el:1.312 --- slime/slime.el:1.311 Wed Jun 9 21:40:22 2004 +++ slime/slime.el Thu Jun 10 10:34:07 2004 @@ -764,7 +764,7 @@ (or (re-search-backward regexp nil t) (re-search-forward regexp nil t))) (goto-char (match-end 0)) - (skip-chars-forward " \n\t\f\r#:") + (skip-chars-forward " \n\t\f\r#") (let ((pkg (ignore-errors (read (current-buffer))))) (cond ((stringp pkg) pkg) @@ -1642,7 +1642,7 @@ ((:ed what) (slime-ed what)) ((:debug-condition thread message) - (apply 'ignore thread) ; stupid XEmacs warns about unused variable + (apply 'ignore thread) ; XEmacs warns about unused variable (message "%s" message))))) (defun slime-reset () @@ -1887,6 +1887,19 @@ (defvar slime-output-end nil "Marker for end of output. New output is inserted at this mark.")) +(defun slime-reset-repl-markers () + (dolist (markname '(slime-output-start + slime-output-end + slime-repl-prompt-start-mark + slime-repl-input-start-mark + slime-repl-input-end-mark + slime-repl-last-input-start-mark)) + (set markname (make-marker)) + (set-marker (symbol-value markname) (point))) + (set-marker-insertion-type slime-repl-input-end-mark t) + (set-marker-insertion-type slime-output-end t) + (set-marker-insertion-type slime-repl-prompt-start-mark t)) + (defun slime-output-buffer (&optional noprompt) "Return the output buffer, create it if necessary." (or (slime-repl-buffer) @@ -1894,17 +1907,7 @@ (with-current-buffer (slime-repl-buffer t) (slime-repl-mode) (setq slime-buffer-connection connection) - (dolist (markname (list 'slime-output-start - 'slime-output-end - 'slime-repl-prompt-start-mark - 'slime-repl-input-start-mark - 'slime-repl-input-end-mark - 'slime-repl-last-input-start-mark)) - (set markname (make-marker)) - (set-marker (symbol-value markname) (point))) - (set-marker-insertion-type slime-repl-input-end-mark t) - (set-marker-insertion-type slime-output-end t) - (set-marker-insertion-type slime-repl-prompt-start-mark t) + (slime-reset-repl-markers) (unless noprompt (slime-repl-insert-prompt "" 0)) (current-buffer))))) @@ -6101,21 +6104,22 @@ (:handler 'slime-set-default-directory) (:one-liner "Change the current directory.")) -;;; XXX move more of this to lisp +(defslime-repl-shortcut nil ("pwd") + (:handler (lambda () + (interactive) + (let ((dir (slime-eval `(swank:default-directory)))) + (message "Directory %s" dir)))) + (:one-liner "Change the current directory.")) + (defslime-repl-shortcut slime-repl-push-directory ("push-directory" "+d" "pushd") (:handler (lambda (directory) (interactive - (list - (expand-file-name - (read-directory-name - "Push directory: " - (slime-eval '(cl:namestring - (cl:truename - cl:*default-pathname-defaults*))) - nil nil "")))) - (push directory slime-repl-directory-stack) - (slime-set-default-directory directory))) + (list (read-directory-name + "Push directory: " + (slime-eval '(swank:default-directory)) nil nil "")) + (push directory slime-repl-directory-stack) + (slime-set-default-directory directory)))) (:one-liner "Push a new directory onto the directory stack.")) (defslime-repl-shortcut slime-repl-pop-directory ("pop-directory" "-d") @@ -6170,36 +6174,16 @@ (slime-repl-send-input))) (:one-liner "Define a new global, special, variable.")) -;;; XXX move more of this to lisp -(defslime-repl-shortcut slime-repl-compile-and-load ("compile-and-load") - (:handler (lambda (file-name) - (interactive (list - (expand-file-name - (read-file-name "File: " - nil nil nil nil - (lambda (filename) - (string-match ".*\\.\\(lisp\\|cl\\)$" filename)))))) - (lexical-let ((lisp-file-name (slime-to-lisp-filename file.lisp))) - (if (slime-eval `(swank::requires-compile-p ,lisp-file-name)) - (progn - (save-some-buffers) - (slime-insert-transcript-delimiter - (format "Compile file %s" lisp-file-name)) - (slime-display-output-buffer) - (slime-eval-async - `(swank:compile-file-for-emacs ,file.lisp nil) - nil - ;; after compiling we must load. - (lexical-let ((buffer (current-buffer))) - (lambda (result) - (slime-compilation-finished result buffer) - (message "Loading %s.." lisp-file-name) - (slime-eval-with-transcript `(swank:load-file ,lisp-file-name) nil)))) - (message "Compiling %s.." lisp-file-name)) - ;; don't need to compile, just load - (progn - (message "Loading %s.." lisp-file-name) - (slime-eval-with-transcript `(swank:load-file ,lisp-file-name) nil)))))) +(defslime-repl-shortcut slime-repl-compile-and-load ("compile-and-load" "cl") + (:handler (lambda (filename) + (interactive (list (expand-file-name + (read-file-name "File: " nil nil nil nil)))) + (save-some-buffers) + (slime-eval-async + `(swank:compile-file-if-needed + ,(slime-to-lisp-filename filename) t) + nil + (slime-compilation-finished-continuation)))) (:one-liner "Compile (if neccessary) and load a lisp file.")) (defslime-repl-shortcut slime-repl-load/force-system ("force-load-system") From heller at common-lisp.net Thu Jun 10 17:51:33 2004 From: heller at common-lisp.net (Helmut Eller) Date: Thu, 10 Jun 2004 10:51:33 -0700 Subject: [slime-cvs] CVS update: slime/swank.lisp Message-ID: Update of /project/slime/cvsroot/slime In directory common-lisp.net:/tmp/cvs-serv31557 Modified Files: swank.lisp Log Message: (*readtable-alist*): New configurable. The keys are package name and the values readtables. The readtable will be used to READ code originating from Emacs buffers in the associated slime-buffer-package. (drop-thread): Simplified. (*buffer-readtable*): New variable. (with-buffer-syntax): New macro. This should be used for code which needs to read or prints expressions with reader and printer variables, in particular *package* and *readtable*, suitable for the Emacs buffer. (to-string, format-values-for-echo-area, interactive-eval) (eval-region, interactive-eval-region, re-evaluate-defvar) (swank-pprint, pprint-eval, listener-eval, compile-string-for-emacs) (disassemble-symbol, describe-to-string, describe-symbol) (describe-function, describe-definition-for-emacs) (documentation-symbol, init-inspector, inspect-nth-part) (inspector-pop, inspector-next, describe-inspecte) (inspect-current-condition): Use it. (parse-string): Renamed from symbol-from-string. Make it case insensitive. (parse-package): New function. (eval-for-emacs): Initialize the *buffer-readtable*. (symbol-indentation): Don't consider symbols in the CL package. Emacs already knows how to indent them. (compile-file-if-needed): Used for REPL shortcut 'compile-and-load'. Date: Thu Jun 10 10:51:33 2004 Author: heller Index: slime/swank.lisp diff -u slime/swank.lisp:1.188 slime/swank.lisp:1.189 --- slime/swank.lisp:1.188 Tue Jun 8 16:57:57 2004 +++ slime/swank.lisp Thu Jun 10 10:51:33 2004 @@ -22,6 +22,7 @@ #:*log-events* #:*use-dedicated-output-stream* #:*configure-emacs-indentation* + #:*readtable-alist* ;; re-exported from backend #:frame-source-location-for-emacs #:restart-frame @@ -30,11 +31,15 @@ #:profile-reset #:unprofile-all #:profile-package + #:default-directory #:set-default-directory #:quit-lisp )) -(in-package :swank) +(in-package #:swank) + +(defvar *cl-package* (find-package :cl)) +(defvar *keyword-package* (find-package :keyword)) (defvar *swank-io-package* (let ((package (make-package :swank-io-package :use '()))) @@ -391,24 +396,12 @@ *thread-counter* id) id)) -(defun drop&find (item list key test) - "Return LIST where item is removed together with the removed -element." - (declare (type function key test)) - (do ((stack '() (cons (car l) stack)) - (l list (cdr l))) - ((null l) (values (nreverse stack) nil)) - (when (funcall test item (funcall key (car l))) - (return (values (nreconc stack (cdr l)) - (car l)))))) - (defun drop-thread (thread) "Drop the first occurence of thread in *active-threads* and return its id." - (multiple-value-bind (list pair) (drop&find thread *active-threads* - #'cdr #'eql) - (setq *active-threads* list) - (assert pair) - (car pair))) + (let ((tail (member thread *active-threads* :key #'cdr :test #'equalp))) + (assert tail) + (setq *active-threads* (append (ldiff *active-threads* tail) (rest tail))) + (car (first tail)))) (defvar *lookup-counter* nil "A simple counter used to remove dead threads from *active-threads*.") @@ -772,29 +765,66 @@ EVAL-FOR-EMACS binds *buffer-package*. Strings originating from a slime buffer are best read in this package. See also FROM-STRING and TO-STRING.") +(defvar *buffer-readtable*) +(setf (documentation '*buffer-readtable* 'symbol) + "Readtable associated with the current buffer") + +(defmacro with-buffer-syntax ((&rest _) &body body) + "Execute BODY with appropriate *package* and *readtable* bindings. + +This should be used for code that is conceptionally executed in an +Emacs buffer." + (destructuring-bind () _ + `(let ((*package* *buffer-package*) + (*readtable* *buffer-readtable*)) + (call-with-syntax-hooks (lambda () , at body))))) + (defun from-string (string) "Read string in the *BUFFER-PACKAGE*" - (let ((*package* *buffer-package*) - (*read-suppress* nil)) - (read-from-string string))) - -(defun symbol-from-string (string) - "Find the symbol named STRING in *BUFFER-PACKAGE*." - ;;; XXX Is this broken with respect to readtable-case? - (find-symbol (string-upcase string) *buffer-package*)) + (with-buffer-syntax () + (let ((*read-suppress* nil)) + (read-from-string string)))) +(defun parse-symbol (string) + "Find the symbol named STRING. +Return the symbol and a flag indicate if the symbols was found." + (multiple-value-bind (sym pos) (let ((*package* *keyword-package*)) + (read-from-string string)) + (if (and (symbolp sym) (= (length string) pos)) + (find-symbol (string sym)) + (values nil nil)))) + +(defun parse-package (string) + "Find the package named STRING. +Return the package or nil." + (multiple-value-bind (sym pos) (let ((*package* *keyword-package*)) + (read-from-string string)) + (if (and (keywordp sym) (= (length string) pos)) + (find-package sym)))) + (defun to-string (string) "Write string in the *BUFFER-PACKAGE*." - (let ((*package* *buffer-package*)) + (with-buffer-syntax () (prin1-to-string string))) (defun guess-package-from-string (name &optional (default-package *package*)) (or (and name - (or (find-package name) + (or (parse-package name) (find-package (string-upcase name)) - (find-package (substitute #\- #\! name)))) + (parse-package (substitute #\- #\! name)))) default-package)) +(defvar *readtable-alist* '() + "An alist mapping package names to readtables.") + +(defun guess-buffer-readtable (package-name &optional (default *readtable*)) + (let ((package (guess-package-from-string package-name))) + (if package + (or (cdr (assoc (package-name package) *readtable-alist* + :test #'string=)) + default) + default))) + (defun find-symbol-designator (string &optional (default-package *buffer-package*)) "Return the symbol corresponding to the symbol designator STRING. @@ -1106,8 +1136,10 @@ (let ((*debugger-hook* #'swank-debugger-hook)) (let (ok result) (unwind-protect - (let ((*buffer-package* (guess-package-from-string buffer-package))) + (let ((*buffer-package* (guess-package-from-string buffer-package)) + (*buffer-readtable* (guess-buffer-readtable buffer-package))) (assert (packagep *buffer-package*)) + (assert (readtablep *buffer-readtable*)) (setq result (eval form)) (force-output) (sync-state-to-emacs) @@ -1118,24 +1150,22 @@ ,id)))))) (defun format-values-for-echo-area (values) - (let ((*package* *buffer-package*)) + (with-buffer-syntax () (cond (values (format nil "~{~S~^, ~}" values)) (t "; No value")))) (defslimefun interactive-eval (string) - (let ((values (multiple-value-list - (let ((*package* *buffer-package*)) - (eval (from-string string)))))) - (fresh-line) - (force-output) - (format-values-for-echo-area values))) + (with-buffer-syntax () + (let ((values (multiple-value-list (eval (read-from-string string))))) + (fresh-line) + (force-output) + (format-values-for-echo-area 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 change, then send Emacs an update." - (let ((*package* *buffer-package*) - - values) + (let (- values) (unwind-protect (with-input-from-string (stream string) (loop for form = (read stream nil stream) @@ -1161,11 +1191,11 @@ finally (return shortest))) (defslimefun interactive-eval-region (string) - (let ((*package* *buffer-package*)) + (with-buffer-syntax () (format-values-for-echo-area (eval-region string)))) (defslimefun re-evaluate-defvar (form) - (let ((*package* *buffer-package*)) + (with-buffer-syntax () (let ((form (read-from-string form))) (destructuring-bind (dv name &optional value doc) form (declare (ignore value doc)) @@ -1193,22 +1223,22 @@ (defun swank-pprint (list) "Bind some printer variables and pretty print each object in LIST." - (let ((*print-pretty* t) - (*print-case* *swank-pprint-case*) - (*print-right-margin* *swank-pprint-right-margin*) - (*print-circle* *swank-pprint-circle*) - (*print-escape* *swank-pprint-escape*) - (*print-level* *swank-pprint-level*) - (*print-length* *swank-pprint-length*) - (*package* *buffer-package*)) - (cond ((null list) "; No value") - (t (with-output-to-string (*standard-output*) - (dolist (o list) - (pprint o) - (terpri))))))) + (with-buffer-syntax () + (let ((*print-pretty* t) + (*print-case* *swank-pprint-case*) + (*print-right-margin* *swank-pprint-right-margin*) + (*print-circle* *swank-pprint-circle*) + (*print-escape* *swank-pprint-escape*) + (*print-level* *swank-pprint-level*) + (*print-length* *swank-pprint-length*)) + (cond ((null list) "; No value") + (t (with-output-to-string (*standard-output*) + (dolist (o list) + (pprint o) + (terpri)))))))) (defslimefun pprint-eval (string) - (let ((*package* *buffer-package*)) + (with-buffer-syntax () (swank-pprint (multiple-value-list (eval (read-from-string string)))))) (defslimefun set-package (package) @@ -1218,13 +1248,13 @@ (defslimefun listener-eval (string) (clear-user-input) - (multiple-value-bind (values last-form) (eval-region string t) - (setq +++ ++ ++ + + last-form - *** ** ** * * (car values) - /// // // / / values) - (cond ((null values) "; No value") - (t - (let ((*package* *buffer-package*)) + (with-buffer-syntax () + (multiple-value-bind (values last-form) (eval-region string t) + (setq +++ ++ ++ + + last-form + *** ** ** * * (car values) + /// // // / / values) + (cond ((null values) "; No value") + (t (format nil "~{~S~^~%~}" values)))))) (defslimefun ed-in-emacs (&optional what) @@ -1299,9 +1329,9 @@ (defslimefun compile-string-for-emacs (string buffer position) "Compile STRING (exerpted from BUFFER at POSITION). Record compiler notes signalled as `compiler-condition's." - (swank-compiler - (lambda () - (let ((*package* *buffer-package*)) + (with-buffer-syntax () + (swank-compiler + (lambda () (swank-compile-string string :buffer buffer :position position))))) (defslimefun operate-on-system-for-emacs (system-name operation &rest keywords) @@ -1345,7 +1375,8 @@ (defslimefun disassemble-symbol (name) (with-output-to-string (*standard-output*) - (disassemble (fdefinition (from-string name))))) + (let ((*print-readably* nil)) + (disassemble (fdefinition (from-string name)))))) ;;;; Completion @@ -1524,7 +1555,8 @@ (defun prefix-match-p (prefix string) "Return true if PREFIX is a prefix of STRING." - (eql (search prefix string) 0)) + (not (mismatch prefix string :end2 (min (length string) (length prefix))))) + ;;;;; Extending the input string by completion @@ -1637,7 +1669,7 @@ If FORCE is true then check all symbols, otherwise only check symbols belonging to the buffer package." (let ((alist '())) - (flet ((consider (symbol) + (flet ((consider (symbol) (let ((indent (symbol-indentation symbol))) (when indent (unless (equal (gethash symbol cache) indent) @@ -1653,14 +1685,23 @@ (consider symbol))))) alist)) +(defun cl-symbol-p (symbol) + "Is SYMBOL a symbol in the COMMON-LISP package?" + (eq (symbol-package symbol) *cl-package*)) + +(defun known-to-emacs-p (symbol) + "Return true if Emacs has special rules for indenting SYMBOL." + (or (cl-symbol-p symbol) + (let ((name (symbol-name symbol))) + (not (or (prefix-match-p "DEF" name) + (prefix-match-p "WITH-" name)))))) + (defun symbol-indentation (symbol) "Return a form describing the indentation of SYMBOL. The form is to be used as the `common-lisp-indent-function' property in Emacs." (if (and (macro-function symbol) - (let ((name (symbol-name symbol))) - (not (or (prefix-match-p "DEF" name) - (prefix-match-p "WITH-" name))))) + (not (known-to-emacs-p symbol))) (let ((arglist (arglist symbol))) (etypecase arglist ((member :not-available) @@ -1773,7 +1814,9 @@ (defun compiled-regex (regex-string) (or (gethash regex-string regex-hash) (setf (gethash regex-string regex-hash) - (compile nil (nregex:regex-compile regex-string)))))) + (if (zerop (length regex-string)) + (lambda (s) (check-type s string) t) + (compile nil (nregex:regex-compile regex-string))))))) (defun apropos-matcher (string case-sensitive package external-only) (let* ((case-modifier (if case-sensitive #'string #'string-upcase)) @@ -1798,30 +1841,37 @@ result)) (defun describe-to-string (object) - (with-output-to-string (*standard-output*) - (describe object))) + (let ((*print-readably* nil)) + (with-output-to-string (*standard-output*) + (describe object)))) (defslimefun describe-symbol (symbol-name) - (describe-to-string (find-symbol-or-lose symbol-name))) + (with-buffer-syntax () + (describe-to-string (find-symbol-or-lose symbol-name)))) -(defslimefun describe-function (symbol-name) - (let ((symbol (find-symbol-or-lose symbol-name))) - (describe-to-string (or (macro-function symbol) - (symbol-function symbol))))) +(defslimefun describe-function (name) + (with-buffer-syntax () + (let ((symbol (find-symbol name))) + (describe-to-string (or (macro-function symbol) + (symbol-function symbol)))))) (defslimefun describe-definition-for-emacs (name kind) - (with-output-to-string (*standard-output*) - (describe-definition (find-symbol-or-lose name) kind))) + (with-buffer-syntax () + (with-output-to-string (*standard-output*) + (describe-definition (find-symbol-or-lose name) kind)))) (defslimefun documentation-symbol (symbol-name &optional default) - (let ((*package* *buffer-package*)) - (let ((vdoc (documentation (symbol-from-string symbol-name) 'variable)) - (fdoc (documentation (symbol-from-string symbol-name) 'function))) - (or (and (or vdoc fdoc) - (concatenate 'string - fdoc - (and vdoc fdoc '(#\Newline #\Newline)) - vdoc)) + (with-buffer-syntax () + (multiple-value-bind (sym foundp) (parse-symbol symbol-name) + (if foundp + (let ((vdoc (documentation sym 'variable)) + (fdoc (documentation sym 'function))) + (or (and (or vdoc fdoc) + (concatenate 'string + fdoc + (and vdoc fdoc '(#\Newline #\Newline)) + vdoc)) + default)) default)))) @@ -1857,12 +1907,22 @@ (defslimefun load-file (filename) (to-string (load filename))) -(defun requires-compile-p (pathname) - (let ((compile-file-truename (probe-file (compile-file-pathname pathname)))) - (or (not compile-file-truename) - (< (file-write-date compile-file-truename) - (file-write-date pathname))))) - +(defun file-newer-p (new-file old-file) + "Returns true if NEW-FILE is newer than OLD-FILE." + (> (file-write-date new-file) (file-write-date old-file))) + +(defun requires-compile-p (source-file) + (let ((fasl-file (probe-file (compile-file-pathname source-file)))) + (or (not fasl-file) + (file-newer-p source-file fasl-file)))) + +(defslimefun compile-file-if-needed (filename loadp) + (cond ((requires-compile-p filename) + (compile-file-for-emacs filename loadp)) + (loadp + (load (compile-file-pathname filename)) + nil))) + ;;;; Profiling @@ -1981,8 +2041,9 @@ (setf (fill-pointer *inspector-history*) 0)) (defslimefun init-inspector (string) - (reset-inspector) - (inspect-object (eval (from-string string)))) + (with-buffer-syntax () + (reset-inspector) + (inspect-object (eval (read-from-string string))))) (defun print-part-to-string (value) (let ((*print-pretty* nil) @@ -2010,22 +2071,25 @@ (cdr (nth index *inspectee-parts*))) (defslimefun inspect-nth-part (index) - (inspect-object (nth-part index))) + (with-buffer-syntax () + (inspect-object (nth-part index)))) (defslimefun inspector-pop () "Drop the inspector stack and inspect the second element. Return nil if there's no second element." - (cond ((cdr *inspector-stack*) - (pop *inspector-stack*) - (inspect-object (pop *inspector-stack*))) - (t nil))) + (with-buffer-syntax () + (cond ((cdr *inspector-stack*) + (pop *inspector-stack*) + (inspect-object (pop *inspector-stack*))) + (t nil)))) (defslimefun inspector-next () "Inspect the next element in the *inspector-history*." - (let ((position (position *inspectee* *inspector-history*))) - (cond ((= (1+ position) (length *inspector-history*)) - nil) - (t (inspect-object (aref *inspector-history* (1+ position))))))) + (with-buffer-syntax () + (let ((position (position *inspectee* *inspector-history*))) + (cond ((= (1+ position) (length *inspector-history*)) + nil) + (t (inspect-object (aref *inspector-history* (1+ position)))))))) (defslimefun quit-inspector () (reset-inspector) @@ -2033,7 +2097,8 @@ (defslimefun describe-inspectee () "Describe the currently inspected object." - (describe-to-string *inspectee*)) + (with-buffer-syntax () + (describe-to-string *inspectee*))) (defmethod inspected-parts ((object cons)) (if (consp (cdr object)) @@ -2084,12 +2149,14 @@ pairs)))) (defslimefun inspect-in-frame (string index) - (reset-inspector) - (inspect-object (eval-in-frame (from-string string) index))) + (with-buffer-syntax () + (reset-inspector) + (inspect-object (eval-in-frame (from-string string) index)))) (defslimefun inspect-current-condition () - (reset-inspector) - (inspect-object *swank-debugger-condition*)) + (with-buffer-syntax () + (reset-inspector) + (inspect-object *swank-debugger-condition*))) ;;;; Thread listing From heller at common-lisp.net Thu Jun 10 17:52:28 2004 From: heller at common-lisp.net (Helmut Eller) Date: Thu, 10 Jun 2004 10:52:28 -0700 Subject: [slime-cvs] CVS update: slime/swank-backend.lisp Message-ID: Update of /project/slime/cvsroot/slime In directory common-lisp.net:/tmp/cvs-serv1253 Modified Files: swank-backend.lisp Log Message: (default-directory, call-with-syntax-hooks): New functions. Date: Thu Jun 10 10:52:28 2004 Author: heller Index: slime/swank-backend.lisp diff -u slime/swank-backend.lisp:1.50 slime/swank-backend.lisp:1.51 --- slime/swank-backend.lisp:1.50 Wed Jun 9 05:35:22 2004 +++ slime/swank-backend.lisp Thu Jun 10 10:52:27 2004 @@ -158,11 +158,19 @@ "Return a short name for the Lisp implementation." (lisp-implementation-type)) +(definterface default-directory () + "Return the default directory." + (directory-namestring (truename *default-pathname-defaults*))) + (definterface set-default-directory (directory) "Set the default directory. This is used to resolve filenames without directory component." (setf *default-pathname-defaults* (truename (merge-pathnames directory))) - (namestring *default-pathname-defaults*)) + (default-directory)) + +(definterface call-with-syntax-hooks (fn) + "Call FN with hooks to handle special syntax." + (funcall fn)) ;;;; Compilation From heller at common-lisp.net Thu Jun 10 17:56:41 2004 From: heller at common-lisp.net (Helmut Eller) Date: Thu, 10 Jun 2004 10:56:41 -0700 Subject: [slime-cvs] CVS update: slime/swank-sbcl.lisp Message-ID: Update of /project/slime/cvsroot/slime In directory common-lisp.net:/tmp/cvs-serv7136 Modified Files: swank-sbcl.lisp Log Message: (call-with-syntax-hooks): Add hooks to fix SB!-style package names. (shebang-readtable): Return a readtable with the readermacros need to parse SBCL sources. Date: Thu Jun 10 10:56:41 2004 Author: heller Index: slime/swank-sbcl.lisp diff -u slime/swank-sbcl.lisp:1.87 slime/swank-sbcl.lisp:1.88 --- slime/swank-sbcl.lisp:1.87 Tue Jun 8 16:57:35 2004 +++ slime/swank-sbcl.lisp Thu Jun 10 10:56:41 2004 @@ -209,7 +209,7 @@ ;; SBCL doesn't have compile-from-stream, so C-c C-c ends up here (defmethod resolve-note-location ((b string) (f (eql :lisp)) pos path source) - ;; Remove the sourounding lambda from the path (was added by + ;; Remove the surrounding lambda from the path (was added by ;; swank-compile-string) (destructuring-bind (_ form &rest rest) path (declare (ignore _)) @@ -633,6 +633,70 @@ (sb-pcl::generic-function-pretty-arglist o)) (cons "Initial-Methods" (sb-pcl::generic-function-initial-methods o))))) + + +;;;; Support for SBCL syntax + +(defun feature-in-list-p (feature list) + (etypecase feature + (symbol (member feature list :test #'eq)) + (cons (flet ((subfeature-in-list-p (subfeature) + (feature-in-list-p subfeature list))) + (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))))))))))) + +(defun shebang-reader (stream sub-character infix-parameter) + (declare (ignore sub-character)) + (when infix-parameter + (error "illegal read syntax: #~D!" infix-parameter)) + (let ((next-char (read-char stream))) + (unless (find next-char "+-") + (error "illegal read syntax: #!~C" next-char)) + ;; When test is not satisfied + ;; FIXME: clearer if order of NOT-P and (NOT NOT-P) were reversed? then + ;; would become "unless test is satisfied".. + (when (let* ((*package* (find-package "KEYWORD")) + (*read-suppress* nil) + (not-p (char= next-char #\-)) + (feature (read stream))) + (if (feature-in-list-p feature *features*) + not-p + (not not-p))) + ;; Read (and discard) a form from input. + (let ((*read-suppress* t)) + (read stream t nil t)))) + (values)) + +(defvar *shebang-readtable* + (let ((*readtable* (copy-readtable nil))) + (set-dispatch-macro-character #\# #\! + (lambda (s c n) (shebang-reader s c n)) + *readtable*) + *readtable*)) + +(defun shebang-readtable () + *shebang-readtable*) + +(defun sbcl-package-p (package) + (let ((name (package-name package))) + (eql (mismatch "SB-" name) 3))) + +(defvar *debootstrap-packages* t) + +(defimplementation call-with-syntax-hooks (fn) + (cond ((and *debootrap-packages* + (sbcl-package-p *package*)) + (handler-bind ((sb-int:bootstrap-package-not-found + #'sb-int:debootstrap-package)) + (funcall fn))) + (t + (funcall fn)))) ;;;; Multiprocessing From heller at common-lisp.net Thu Jun 10 17:57:16 2004 From: heller at common-lisp.net (Helmut Eller) Date: Thu, 10 Jun 2004 10:57:16 -0700 Subject: [slime-cvs] CVS update: slime/swank-loader.lisp Message-ID: Update of /project/slime/cvsroot/slime In directory common-lisp.net:/tmp/cvs-serv7487 Modified Files: swank-loader.lisp Log Message: Initialize swank::*readtable-alist* for SBCL. Date: Thu Jun 10 10:57:16 2004 Author: heller Index: slime/swank-loader.lisp diff -u slime/swank-loader.lisp:1.24 slime/swank-loader.lisp:1.25 --- slime/swank-loader.lisp:1.24 Wed Jun 9 13:08:39 2004 +++ slime/swank-loader.lisp Thu Jun 10 10:57:16 2004 @@ -102,6 +102,12 @@ (funcall (intern (string :warn-unimplemented-interfaces) :swank-backend)) +#+sbcl +(let ((readtable (swank-backend::shebang-readtable))) + (dolist (p (list-all-packages)) + (when (swank-backend::sbcl-package-p p) + (push (cons (package-name p) readtable) swank::*readtable-alist*)))) + (when (user-init-file) (load (user-init-file))) From heller at common-lisp.net Thu Jun 10 18:08:24 2004 From: heller at common-lisp.net (Helmut Eller) Date: Thu, 10 Jun 2004 11:08:24 -0700 Subject: [slime-cvs] CVS update: slime/ChangeLog Message-ID: Update of /project/slime/cvsroot/slime In directory common-lisp.net:/tmp/cvs-serv20912 Modified Files: ChangeLog Log Message: *** empty log message *** Date: Thu Jun 10 11:08:23 2004 Author: heller Index: slime/ChangeLog diff -u slime/ChangeLog:1.390 slime/ChangeLog:1.391 --- slime/ChangeLog:1.390 Wed Jun 9 21:40:28 2004 +++ slime/ChangeLog Thu Jun 10 11:08:23 2004 @@ -1,3 +1,48 @@ +2004-06-10 Christophe Rhodes + + * swank-sbcl.lisp (call-with-syntax-hooks): Add hooks to fix + "SB!"-style package names. + (shebang-readtable): Return a readtable with readermacros needed + to parse SBCL sources. + + * swank.lisp (with-buffer-syntax): New macro. This should be used + for code which needs to READ code from Emacs buffers. *package* + and *readtable* are bound suitable values. + (to-string, format-values-for-echo-area, interactive-eval) + (eval-region, interactive-eval-region, re-evaluate-defvar) + (swank-pprint, pprint-eval, listener-eval) + (compile-string-for-emacs, disassemble-symbol, describe-to-string) + (describe-symbol, describe-function) + (describe-definition-for-emacs) + (documentation-symbol, init-inspector, inspect-nth-part) + (inspector-pop, inspector-next, describe-inspectee) + (inspect-current-condition): Use it. + +2004-06-10 Helmut Eller + + * swank-loader.lisp: Initialize swank::*readtable-alist* for SBCL. + + * swank-backend.lisp (default-directory, call-with-syntax-hooks): + New functions. + + * swank.lisp (*readtable-alist*): New configurable. The keys are + package name and the values readtables. The readtable will be + used to READ code originating from Emacs buffers in the associated + slime-buffer-package. + (drop-thread): Simplified. + (*buffer-readtable*): New variable. + (parse-package): New function. + (parse-string): Renamed from symbol-from-string. Make it case + insensitive. + (eval-for-emacs): Initialize the *buffer-readtable*. + (symbol-indentation): Don't consider symbols in the CL package. + Emacs already knows how to indent them. + (compile-file-if-needed): Used for REPL shortcut + 'compile-and-load'. + + * slime.el (pwd): Re-add REPL shortcut. + (slime-repl-push-directory, slime-repl-compile-and-load): Simplified. + 2004-06-10 Luke Gorrie * slime.el (sldb-step): Command is disabled because the function From heller at common-lisp.net Thu Jun 10 20:52:07 2004 From: heller at common-lisp.net (Helmut Eller) Date: Thu, 10 Jun 2004 13:52:07 -0700 Subject: [slime-cvs] CVS update: slime/swank-sbcl.lisp Message-ID: Update of /project/slime/cvsroot/slime In directory common-lisp.net:/tmp/cvs-serv6210 Modified Files: swank-sbcl.lisp Log Message: *** empty log message *** Date: Thu Jun 10 13:52:07 2004 Author: heller Index: slime/swank-sbcl.lisp diff -u slime/swank-sbcl.lisp:1.88 slime/swank-sbcl.lisp:1.89 --- slime/swank-sbcl.lisp:1.88 Thu Jun 10 10:56:41 2004 +++ slime/swank-sbcl.lisp Thu Jun 10 13:52:07 2004 @@ -690,7 +690,7 @@ (defvar *debootstrap-packages* t) (defimplementation call-with-syntax-hooks (fn) - (cond ((and *debootrap-packages* + (cond ((and *debootstrap-packages* (sbcl-package-p *package*)) (handler-bind ((sb-int:bootstrap-package-not-found #'sb-int:debootstrap-package)) From hildemegsrod at indiemail.com Thu Jun 10 23:18:10 2004 From: hildemegsrod at indiemail.com (Weston Ray) Date: Thu, 10 Jun 2004 18:18:10 -0500 Subject: [slime-cvs] 1/2--Price Smokes - Marlboro, Camel, Winston, Kool, Newport, Pall Mall, Merit, Dunhill, ID: z294OH56 Message-ID: An HTML attachment was scrubbed... URL: From nsuuimsvcmfatz at hotmail.com Fri Jun 11 11:55:58 2004 From: nsuuimsvcmfatz at hotmail.com (Penelope Kenny) Date: Fri, 11 Jun 2004 05:55:58 -0600 Subject: [slime-cvs] Please pick up your refill now Message-ID: An HTML attachment was scrubbed... URL: From lo3voers at yahoo.com Fri Jun 11 19:55:37 2004 From: lo3voers at yahoo.com (Rex Burgess) Date: Fri, 11 Jun 04 19:55:37 GMT Subject: [slime-cvs] . m mpwkh Message-ID: k jeh r From wnsnavfsmznpb at copacabana.com Sat Jun 12 02:37:26 2004 From: wnsnavfsmznpb at copacabana.com (Mel Buck) Date: Sat, 12 Jun 2004 02:37:26 -0000 Subject: [slime-cvs] Re: Got Meds? We ship overnight. No Prescription Needed. Best Source Online. Message-ID: An HTML attachment was scrubbed... URL: From heller at common-lisp.net Sat Jun 12 12:01:23 2004 From: heller at common-lisp.net (Helmut Eller) Date: Sat, 12 Jun 2004 05:01:23 -0700 Subject: [slime-cvs] CVS update: slime/swank-openmcl.lisp Message-ID: Update of /project/slime/cvsroot/slime In directory common-lisp.net:/tmp/cvs-serv16622 Modified Files: swank-openmcl.lisp Log Message: (send, receive): Ensure that messages are never nil. Date: Sat Jun 12 05:01:23 2004 Author: heller Index: slime/swank-openmcl.lisp diff -u slime/swank-openmcl.lisp:1.75 slime/swank-openmcl.lisp:1.76 --- slime/swank-openmcl.lisp:1.75 Wed May 12 21:47:51 2004 +++ slime/swank-openmcl.lisp Sat Jun 12 05:01:23 2004 @@ -556,6 +556,7 @@ mailbox)))))) (defimplementation send (thread message) + (assert message) (let* ((mbox (mailbox thread)) (mutex (mailbox.mutex mbox))) (ccl:with-lock-grabbed (mutex) @@ -568,6 +569,7 @@ (mutex (mailbox.mutex mbox))) (ccl:wait-on-semaphore (mailbox.semaphore mbox)) (ccl:with-lock-grabbed (mutex) + (assert (mailbox.queue mbox)) (pop (mailbox.queue mbox))))) (defimplementation quit-lisp () From heller at common-lisp.net Sat Jun 12 12:21:14 2004 From: heller at common-lisp.net (Helmut Eller) Date: Sat, 12 Jun 2004 05:21:14 -0700 Subject: [slime-cvs] CVS update: slime/swank.lisp Message-ID: Update of /project/slime/cvsroot/slime In directory common-lisp.net:/tmp/cvs-serv10109 Modified Files: swank.lisp Log Message: (parse-symbol, parse-package): Handle reader errors. Date: Sat Jun 12 05:21:14 2004 Author: heller Index: slime/swank.lisp diff -u slime/swank.lisp:1.189 slime/swank.lisp:1.190 --- slime/swank.lisp:1.189 Thu Jun 10 10:51:33 2004 +++ slime/swank.lisp Sat Jun 12 05:21:13 2004 @@ -789,19 +789,22 @@ "Find the symbol named STRING. Return the symbol and a flag indicate if the symbols was found." (multiple-value-bind (sym pos) (let ((*package* *keyword-package*)) - (read-from-string string)) - (if (and (symbolp sym) (= (length string) pos)) + (ignore-errors (read-from-string string))) + (if (and (symbolp sym) (eql (length string) pos)) (find-symbol (string sym)) (values nil nil)))) (defun parse-package (string) "Find the package named STRING. Return the package or nil." - (multiple-value-bind (sym pos) (let ((*package* *keyword-package*)) - (read-from-string string)) + (multiple-value-bind (sym pos) + (if (zerop (length string)) + (values :|| 0) + (let ((*package* *keyword-package*)) + (ignore-errors (read-from-string string)))) (if (and (keywordp sym) (= (length string) pos)) (find-package sym)))) - + (defun to-string (string) "Write string in the *BUFFER-PACKAGE*." (with-buffer-syntax () From heller at common-lisp.net Sat Jun 12 12:27:29 2004 From: heller at common-lisp.net (Helmut Eller) Date: Sat, 12 Jun 2004 05:27:29 -0700 Subject: [slime-cvs] CVS update: slime/swank-allegro.lisp Message-ID: Update of /project/slime/cvsroot/slime In directory common-lisp.net:/tmp/cvs-serv15398 Modified Files: swank-allegro.lisp Log Message: (format-sldb-condition, condition-references): Add workarounds for buggy no-applicable-method. Date: Sat Jun 12 05:27:29 2004 Author: heller Index: slime/swank-allegro.lisp diff -u slime/swank-allegro.lisp:1.33 slime/swank-allegro.lisp:1.34 --- slime/swank-allegro.lisp:1.33 Mon Jun 7 11:27:03 2004 +++ slime/swank-allegro.lisp Sat Jun 12 05:27:29 2004 @@ -45,7 +45,17 @@ (defimplementation accept-connection (socket) (socket:accept-connection socket :wait t)) +;; The following defitinions are workarounds for the buggy +;; no-applicable-method function in Allegro 5. We have to provide an +;; implementation. (defimplementation emacs-connected ()) + +(defimplementation format-sldb-condition (c) + (princ-to-string c)) + +(defimplementation condition-references (c) + (declare (ignore)) + '()) ;;;; Unix signals From heller at common-lisp.net Sat Jun 12 12:29:31 2004 From: heller at common-lisp.net (Helmut Eller) Date: Sat, 12 Jun 2004 05:29:31 -0700 Subject: [slime-cvs] CVS update: slime/ChangeLog Message-ID: Update of /project/slime/cvsroot/slime In directory common-lisp.net:/tmp/cvs-serv17547 Modified Files: ChangeLog Log Message: *** empty log message *** Date: Sat Jun 12 05:29:31 2004 Author: heller Index: slime/ChangeLog diff -u slime/ChangeLog:1.391 slime/ChangeLog:1.392 --- slime/ChangeLog:1.391 Thu Jun 10 11:08:23 2004 +++ slime/ChangeLog Sat Jun 12 05:29:31 2004 @@ -1,3 +1,14 @@ +2004-06-12 heller +2004-06-12 Helmut Eller + + * wank-allegro.lisp (format-sldb-condition, condition-references): + Add workarounds for buggy no-applicable-method. + + * swank.lisp (parse-symbol, parse-package): Handle reader errors. + + * swank-openmcl.lisp (send, receive): Ensure that messages are + never nil. + 2004-06-10 Christophe Rhodes * swank-sbcl.lisp (call-with-syntax-hooks): Add hooks to fix From heller at common-lisp.net Sat Jun 12 12:30:28 2004 From: heller at common-lisp.net (Helmut Eller) Date: Sat, 12 Jun 2004 05:30:28 -0700 Subject: [slime-cvs] CVS update: slime/ChangeLog Message-ID: Update of /project/slime/cvsroot/slime In directory common-lisp.net:/tmp/cvs-serv19480 Modified Files: ChangeLog Log Message: *** empty log message *** Date: Sat Jun 12 05:30:28 2004 Author: heller Index: slime/ChangeLog diff -u slime/ChangeLog:1.392 slime/ChangeLog:1.393 --- slime/ChangeLog:1.392 Sat Jun 12 05:29:31 2004 +++ slime/ChangeLog Sat Jun 12 05:30:28 2004 @@ -1,4 +1,3 @@ -2004-06-12 heller 2004-06-12 Helmut Eller * wank-allegro.lisp (format-sldb-condition, condition-references): From snowballsbf at comcast.net Sun Jun 13 20:03:27 2004 From: snowballsbf at comcast.net (Booker Kline) Date: Mon, 14 Jun 2004 01:03:27 +0500 Subject: [slime-cvs] Your application was approved Message-ID: An HTML attachment was scrubbed... URL: From lgorrie at common-lisp.net Tue Jun 15 17:01:04 2004 From: lgorrie at common-lisp.net (Luke Gorrie) Date: Tue, 15 Jun 2004 10:01:04 -0700 Subject: [slime-cvs] CVS update: slime/slime.el Message-ID: Update of /project/slime/cvsroot/slime In directory common-lisp.net:/tmp/cvs-serv17998 Modified Files: slime.el Log Message: (slime-compile-file): Just prompt for saving the current file instead of calling `save-some-buffers'. Based on a patch from Brian Downing. Date: Tue Jun 15 10:01:04 2004 Author: lgorrie Index: slime/slime.el diff -u slime/slime.el:1.312 slime/slime.el:1.313 --- slime/slime.el:1.312 Thu Jun 10 10:34:07 2004 +++ slime/slime.el Tue Jun 15 10:01:04 2004 @@ -2586,7 +2586,11 @@ (interactive) (unless (eq major-mode 'lisp-mode) (error "Only valid in lisp-mode")) - (save-some-buffers) + (unless buffer-file-name + (error "Buffer %s is not associated with a file." (buffer-name))) + (when (and (buffer-modified-p) + (y-or-n-p (format "Save file %s? " (buffer-file-name)))) + (save-buffer)) (let ((lisp-filename (slime-to-lisp-filename (buffer-file-name)))) (slime-insert-transcript-delimiter (format "Compile file %s" lisp-filename)) From lgorrie at common-lisp.net Tue Jun 15 17:01:11 2004 From: lgorrie at common-lisp.net (Luke Gorrie) Date: Tue, 15 Jun 2004 10:01:11 -0700 Subject: [slime-cvs] CVS update: slime/ChangeLog Message-ID: Update of /project/slime/cvsroot/slime In directory common-lisp.net:/tmp/cvs-serv18259 Modified Files: ChangeLog Log Message: Date: Tue Jun 15 10:01:11 2004 Author: lgorrie Index: slime/ChangeLog diff -u slime/ChangeLog:1.393 slime/ChangeLog:1.394 --- slime/ChangeLog:1.393 Sat Jun 12 05:30:28 2004 +++ slime/ChangeLog Tue Jun 15 10:01:11 2004 @@ -1,3 +1,9 @@ +2004-06-15 Luke Gorrie + + * slime.el (slime-compile-file): Just prompt for saving the + current file instead of calling `save-some-buffers'. Based on a + patch from Brian Downing. + 2004-06-12 Helmut Eller * wank-allegro.lisp (format-sldb-condition, condition-references): From judygrayrod at drsmail.com Tue Jun 15 23:44:58 2004 From: judygrayrod at drsmail.com (Teddy Watts) Date: Tue, 15 Jun 2004 18:44:58 -0500 Subject: [slime-cvs] University Certificates, No Classes Needed, ID: q569cz29 Message-ID: An HTML attachment was scrubbed... URL: From lgorrie at common-lisp.net Wed Jun 16 00:13:42 2004 From: lgorrie at common-lisp.net (Luke Gorrie) Date: Tue, 15 Jun 2004 17:13:42 -0700 Subject: [slime-cvs] CVS update: slime/slime.el Message-ID: Update of /project/slime/cvsroot/slime In directory common-lisp.net:/tmp/cvs-serv16768 Modified Files: slime.el Log Message: (slime-backend): This variable can now be set to an absolute filename. Date: Tue Jun 15 17:13:42 2004 Author: lgorrie Index: slime/slime.el diff -u slime/slime.el:1.313 slime/slime.el:1.314 --- slime/slime.el:1.313 Tue Jun 15 10:01:04 2004 +++ slime/slime.el Tue Jun 15 17:13:42 2004 @@ -76,8 +76,10 @@ "Number of times to try connecting to the Swank server before aborting. Nil means never give up.") -(defvar slime-backend "swank-loader" - "The name of the Lisp file implementing the Swank server.") +(defvar slime-backend "swank-loader.lisp" + "*The name of the Lisp file that loads the Swank server. +This name is interpreted relative to the directory containing +slime.el, but could also be set to an absolute filename.") (make-variable-buffer-local (defvar slime-buffer-package nil @@ -1134,7 +1136,9 @@ (comint-send-string (inferior-lisp-proc) (format "(load %S)\n" (slime-to-lisp-filename - (concat slime-path slime-backend)))) + (if (file-name-absolute-p slime-backend) + slime-backend + (concat slime-path slime-backend))))) (slime-maybe-start-multiprocessing))) (defun slime-maybe-start-multiprocessing () From lgorrie at common-lisp.net Wed Jun 16 00:13:48 2004 From: lgorrie at common-lisp.net (Luke Gorrie) Date: Tue, 15 Jun 2004 17:13:48 -0700 Subject: [slime-cvs] CVS update: slime/ChangeLog Message-ID: Update of /project/slime/cvsroot/slime In directory common-lisp.net:/tmp/cvs-serv16804 Modified Files: ChangeLog Log Message: Date: Tue Jun 15 17:13:48 2004 Author: lgorrie Index: slime/ChangeLog diff -u slime/ChangeLog:1.394 slime/ChangeLog:1.395 --- slime/ChangeLog:1.394 Tue Jun 15 10:01:11 2004 +++ slime/ChangeLog Tue Jun 15 17:13:48 2004 @@ -1,3 +1,8 @@ +2004-06-16 Robert Lehr + + * slime.el (slime-backend): This variable can now be set to an + absolute filename. + 2004-06-15 Luke Gorrie * slime.el (slime-compile-file): Just prompt for saving the From uncdkotrutoco at cox.com Wed Jun 16 03:38:55 2004 From: uncdkotrutoco at cox.com (Denver Winn) Date: Tue, 15 Jun 2004 23:38:55 -0400 Subject: [slime-cvs] Re: Ignore "Viagra", "Cialis" is the BEST! Message-ID: An HTML attachment was scrubbed... URL: From cythiawendeltin at hockeyemail.com Wed Jun 16 15:06:10 2004 From: cythiawendeltin at hockeyemail.com (Vincent Ivey) Date: Wed, 16 Jun 2004 10:06:10 -0500 Subject: [slime-cvs] STOCK-MARKET Investors - OSSI, the Next Ditech, LendingTree, or Countrywide? You Have To See the Barchart Indicators On This One, ID: X784ao04 Message-ID: An HTML attachment was scrubbed... URL: From asimon at common-lisp.net Wed Jun 16 19:39:06 2004 From: asimon at common-lisp.net (Andras Simon) Date: Wed, 16 Jun 2004 12:39:06 -0700 Subject: [slime-cvs] CVS update: slime/swank-abcl.lisp Message-ID: Update of /project/slime/cvsroot/slime In directory common-lisp.net:/tmp/cvs-serv24695 Modified Files: swank-abcl.lisp Log Message: find-definitions Date: Wed Jun 16 12:39:06 2004 Author: asimon Index: slime/swank-abcl.lisp diff -u slime/swank-abcl.lisp:1.1 slime/swank-abcl.lisp:1.2 --- slime/swank-abcl.lisp:1.1 Wed Jun 9 13:08:16 2004 +++ slime/swank-abcl.lisp Wed Jun 16 12:39:06 2004 @@ -254,6 +254,19 @@ |# +(defun source-location (symbol) + (when (ext:source symbol) + `(((,symbol) + (:location + (:file ,(namestring (ext:source-pathname symbol))) + (:position ,(ext:source-file-position symbol) t) + (:snippet nil)))))) + + +(defimplementation find-definitions (symbol) + (source-location symbol)) + + #| Should work (with a patched xref.lisp) but is it any use without find-definitions? ;;;; XREF From heller at common-lisp.net Wed Jun 16 20:24:56 2004 From: heller at common-lisp.net (Helmut Eller) Date: Wed, 16 Jun 2004 13:24:56 -0700 Subject: [slime-cvs] CVS update: slime/slime.el Message-ID: Update of /project/slime/cvsroot/slime In directory common-lisp.net:/tmp/cvs-serv18492 Modified Files: slime.el Log Message: (slime-set-default-directory): Don't call slime-repl-update-banner in Emacs 20. (slime-show-source-location, slime-recenter-window): Use set-window-start instead of recenter; this avoids flickering. (sldb-list-locals): Don't forget about slime-current-thread in the temporary buffer. (Fixes bug reported by Mike Beedle.) (sldb-step): Re-enabled. The CMUCL backend has rudimentary support for stepping. Date: Wed Jun 16 13:24:56 2004 Author: heller Index: slime/slime.el diff -u slime/slime.el:1.314 slime/slime.el:1.315 --- slime/slime.el:1.314 Tue Jun 15 17:13:42 2004 +++ slime/slime.el Wed Jun 16 13:24:56 2004 @@ -125,9 +125,6 @@ (defvar slime-reply-update-banner-p t "Whether Slime should keep a repl banner updated or not.") -(defvar slime-enable-startup-animation-p t - "*Flag to suppress the animation at the beginning.") - (defvar slime-edit-definition-fallback-function nil "Function to call when edit-definition fails to find the source itself. The function is called with the definition name, a string, as its argument. @@ -321,6 +318,11 @@ "List of functions to call when SLIME connects to Lisp." :group 'slime :type 'hook) + +(defcustom slime-startup-animation t + "Enable the startup animation." + :type '(choice (const :tag "Enable" t) (const :tag "Disable" nil)) + :group 'slime) ;;; Minor modes @@ -1124,7 +1126,7 @@ "Offer to rename *inferior-lisp* so that another can be started." (when (y-or-n-p "Create an additional *inferior-lisp*? ") (with-current-buffer "*inferior-lisp*" - (rename-buffer (buffer-name) t) + (rename-buffer (generate-new-buffer-name (buffer-name))) t))) (defun slime-maybe-start-lisp () @@ -1925,7 +1927,7 @@ slime-reply-update-banner-p)) ;; and dancing text (animantep (and (fboundp 'animate-string) - slime-enable-startup-animation-p + slime-startup-animation (zerop (buffer-size))))) (when use-header-p (setq header-line-format banner)) @@ -4597,12 +4599,13 @@ (defun slime-set-default-directory (directory) (interactive (list (read-directory-name "Directory: " nil nil t))) - (with-current-buffer (slime-output-buffer) - (setq default-directory (expand-file-name directory)) - (slime-repl-update-banner)) (message "default-directory: %s" (slime-eval `(swank:set-default-directory - ,(expand-file-name directory))))) + ,(expand-file-name directory)))) + (with-current-buffer (slime-output-buffer) + (setq default-directory (expand-file-name directory)) + (when (boundp 'header-line-format) + (slime-repl-update-banner)))) (defun slime-sync-package-and-default-directory () (interactive) @@ -5025,11 +5028,21 @@ (when sldb-highlight (sldb-highlight-sexp)) (let ((position (point))) (save-selected-window - (select-window (or (get-buffer-window (current-buffer) t) - (display-buffer (current-buffer) t))) - (goto-char position) - (unless (pos-visible-in-window-p) - (recenter sldb-show-location-recenter-arg))))) + (let ((w (select-window (or (get-buffer-window (current-buffer) t) + (display-buffer (current-buffer) t))))) + (goto-char position) + (unless (pos-visible-in-window-p) + (slime-recenter-window w sldb-show-location-recenter-arg)))))) + +(defun slime-recenter-window (window line) + "Set window-start in WINDOW LINE lines before point." + (let ((line (if (not line) + (/ (window-height window) 2) + line))) + (let ((start (ignore-errors (loop repeat line do (forward-line -1)) + (point)))) + (when start + (set-window-start w (point)))))) (defun sldb-highlight-sexp (&optional start end) "Highlight the first sexp after point." @@ -5173,11 +5186,10 @@ (defun sldb-sugar-move (move-fn) (let ((inhibit-read-only t)) - (when (sldb-frame-details-visible-p) - (sldb-hide-frame-details)) + (when (sldb-frame-details-visible-p) (sldb-hide-frame-details)) (funcall move-fn) - (sldb-toggle-details t) - (sldb-show-source))) + (sldb-show-source) + (sldb-toggle-details t))) (defun sldb-details-up () "Select previous frame and show details." @@ -5203,10 +5215,12 @@ (defun sldb-list-locals () "List local variables in selected frame." (interactive) - (let ((frame (sldb-frame-number-at-point))) + (let ((frame (sldb-frame-number-at-point)) + (thread slime-current-thread)) (slime-message "%s" (with-temp-buffer - (sldb-insert-locals frame "") - (buffer-string))))) + (let ((slime-current-thread thread)) + (sldb-insert-locals frame "") + (buffer-string)))))) (defun sldb-catch-tags (frame) (slime-eval `(swank:frame-catch-tags-for-emacs ,frame))) @@ -5263,8 +5277,6 @@ (defun sldb-step () "Select the \"continue\" restart and set a new break point." (interactive) - ;; FIXME - (error "Not implemented.") (let ((frame (sldb-frame-number-at-point))) (slime-eval-async `(swank:sldb-step ,frame) nil (lambda ())))) From heller at common-lisp.net Wed Jun 16 20:25:09 2004 From: heller at common-lisp.net (Helmut Eller) Date: Wed, 16 Jun 2004 13:25:09 -0700 Subject: [slime-cvs] CVS update: slime/swank-backend.lisp Message-ID: Update of /project/slime/cvsroot/slime In directory common-lisp.net:/tmp/cvs-serv20801 Modified Files: swank-backend.lisp Log Message: (sldb-step, default-readtable-alist): New backend functions. Date: Wed Jun 16 13:25:09 2004 Author: heller Index: slime/swank-backend.lisp diff -u slime/swank-backend.lisp:1.51 slime/swank-backend.lisp:1.52 --- slime/swank-backend.lisp:1.51 Thu Jun 10 10:52:27 2004 +++ slime/swank-backend.lisp Wed Jun 16 13:25:09 2004 @@ -39,7 +39,7 @@ "List of interface functions that are not implemented. DEFINTERFACE adds to this list and DEFIMPLEMENTATION removes.") -(defmacro definterface (name args documentation &body default-body) +(defmacro definterface (name args documentation &rest default-body) "Define an interface function for the backend to implement. A generic function is defined with NAME, ARGS, and DOCUMENTATION. @@ -172,6 +172,10 @@ "Call FN with hooks to handle special syntax." (funcall fn)) +(definterface default-readtable-alist () + "Return a suitable initial value for SWANK:*READTABLE-ALIST*." + '()) + ;;;; Compilation @@ -386,6 +390,10 @@ symbol-or-name) (:SBCL :NODE node-name)" '()) + +(definterface sldb-step (frame-number) + "Step to the next code location in the frame FRAME-NUMBER.") + ;;;; Definition finding From heller at common-lisp.net Wed Jun 16 20:25:25 2004 From: heller at common-lisp.net (Helmut Eller) Date: Wed, 16 Jun 2004 13:25:25 -0700 Subject: [slime-cvs] CVS update: slime/swank-cmucl.lisp Message-ID: Update of /project/slime/cvsroot/slime In directory common-lisp.net:/tmp/cvs-serv22520 Modified Files: swank-cmucl.lisp Log Message: (default-directory): Add implementation. (sldb-step): Uncomment it and remove references to *swank-debugger-condition*. Date: Wed Jun 16 13:25:25 2004 Author: heller Index: slime/swank-cmucl.lisp diff -u slime/swank-cmucl.lisp:1.106 slime/swank-cmucl.lisp:1.107 --- slime/swank-cmucl.lisp:1.106 Tue Jun 8 13:32:50 2004 +++ slime/swank-cmucl.lisp Wed Jun 16 13:25:25 2004 @@ -1408,6 +1408,9 @@ ;; Setting *default-pathname-defaults* to an absolute directory ;; makes the behavior of MERGE-PATHNAMES a bit more intuitive. (setf *default-pathname-defaults* (pathname (ext:default-directory))) + (default-directory)) + +(defimplementation default-directory () (namestring (ext:default-directory))) (defimplementation call-without-interrupts (fn) @@ -1513,13 +1516,12 @@ :kind :function-end))) (di:activate-breakpoint bp))))))) -;; (defslimefun sldb-step (frame) -;; (cond ((find-restart 'continue *swank-debugger-condition*) -;; (set-step-breakpoints (nth-frame frame)) -;; (continue *swank-debugger-condition*)) -;; (t -;; (error "Cannot continue in from condition: ~A" -;; *swank-debugger-condition*)))) +(defimplementation sldb-step (frame) + (cond ((find-restart 'continue) + (set-step-breakpoints (nth-frame frame)) + (continue)) + (t + (error "No continue restart.")))) (defun frame-cfp (frame) "Return the Control-Stack-Frame-Pointer for FRAME." From heller at common-lisp.net Wed Jun 16 20:25:46 2004 From: heller at common-lisp.net (Helmut Eller) Date: Wed, 16 Jun 2004 13:25:46 -0700 Subject: [slime-cvs] CVS update: slime/swank-loader.lisp Message-ID: Update of /project/slime/cvsroot/slime In directory common-lisp.net:/tmp/cvs-serv24652 Modified Files: swank-loader.lisp Log Message: Move readtable-alist initialization to the swank-sbcl.lisp. Date: Wed Jun 16 13:25:46 2004 Author: heller Index: slime/swank-loader.lisp diff -u slime/swank-loader.lisp:1.25 slime/swank-loader.lisp:1.26 --- slime/swank-loader.lisp:1.25 Thu Jun 10 10:57:16 2004 +++ slime/swank-loader.lisp Wed Jun 16 13:25:46 2004 @@ -102,12 +102,6 @@ (funcall (intern (string :warn-unimplemented-interfaces) :swank-backend)) -#+sbcl -(let ((readtable (swank-backend::shebang-readtable))) - (dolist (p (list-all-packages)) - (when (swank-backend::sbcl-package-p p) - (push (cons (package-name p) readtable) swank::*readtable-alist*)))) - (when (user-init-file) (load (user-init-file))) From heller at common-lisp.net Wed Jun 16 20:26:01 2004 From: heller at common-lisp.net (Helmut Eller) Date: Wed, 16 Jun 2004 13:26:01 -0700 Subject: [slime-cvs] CVS update: slime/swank-sbcl.lisp Message-ID: Update of /project/slime/cvsroot/slime In directory common-lisp.net:/tmp/cvs-serv26639 Modified Files: swank-sbcl.lisp Log Message: * swank-sbcl.lisp (default-readtable-alist): Implement it. Date: Wed Jun 16 13:26:01 2004 Author: heller Index: slime/swank-sbcl.lisp diff -u slime/swank-sbcl.lisp:1.89 slime/swank-sbcl.lisp:1.90 --- slime/swank-sbcl.lisp:1.89 Thu Jun 10 13:52:07 2004 +++ slime/swank-sbcl.lisp Wed Jun 16 13:26:01 2004 @@ -698,6 +698,11 @@ (t (funcall fn)))) +(defimplementation default-readtable-alist () + (let ((readtable (shebang-readtable))) + (loop for p in (remove-if-not #'sbcl-package-p (list-all-packages)) + collect (cons (package-name p) readtable)))) + ;;;; Multiprocessing From heller at common-lisp.net Wed Jun 16 20:26:58 2004 From: heller at common-lisp.net (Helmut Eller) Date: Wed, 16 Jun 2004 13:26:58 -0700 Subject: [slime-cvs] CVS update: slime/swank.lisp Message-ID: Update of /project/slime/cvsroot/slime In directory common-lisp.net:/tmp/cvs-serv1971 Modified Files: swank.lisp Log Message: (*readtable-alist*): Call backend function for initialization. (eval-for-emacs, guess-buffer-package): Signal a continuable error if a package name was supplied but no such package exists. Not sure if this is better than what we did before (i.e. silently use the current package). Date: Wed Jun 16 13:26:58 2004 Author: heller Index: slime/swank.lisp diff -u slime/swank.lisp:1.190 slime/swank.lisp:1.191 --- slime/swank.lisp:1.190 Sat Jun 12 05:21:13 2004 +++ slime/swank.lisp Wed Jun 16 13:26:58 2004 @@ -26,6 +26,7 @@ ;; re-exported from backend #:frame-source-location-for-emacs #:restart-frame + #:sldb-step #:profiled-functions #:profile-report #:profile-reset @@ -817,7 +818,7 @@ (parse-package (substitute #\- #\! name)))) default-package)) -(defvar *readtable-alist* '() +(defvar *readtable-alist* (default-readtable-alist) "An alist mapping package names to readtables.") (defun guess-buffer-readtable (package-name &optional (default *readtable*)) @@ -1132,6 +1133,19 @@ (destructuring-bind (fn &rest args) form (send-to-emacs `(:%apply ,(string-downcase (string fn)) ,args)))) +(defun guess-buffer-package (string) + "Return a package for STRING. +Print a warning if STRING is not nil but no such package exists." + (cond ((guess-package-from-string string nil)) + (string + (cerror (format nil "Use current package. [~A]" + (package-name *package*)) + "Package ~A not found." + string (package-name *package*)) + *package*) + (t + *package*))) + (defun eval-for-emacs (form buffer-package id) "Bind *BUFFER-PACKAGE* BUFFER-PACKAGE and evaluate FORM. Return the result values as a list to strings to the continuation ID. @@ -1139,7 +1153,7 @@ (let ((*debugger-hook* #'swank-debugger-hook)) (let (ok result) (unwind-protect - (let ((*buffer-package* (guess-package-from-string buffer-package)) + (let ((*buffer-package* (guess-buffer-package buffer-package)) (*buffer-readtable* (guess-buffer-readtable buffer-package))) (assert (packagep *buffer-package*)) (assert (readtablep *buffer-readtable*)) From heller at common-lisp.net Wed Jun 16 20:27:14 2004 From: heller at common-lisp.net (Helmut Eller) Date: Wed, 16 Jun 2004 13:27:14 -0700 Subject: [slime-cvs] CVS update: slime/swank-allegro.lisp Message-ID: Update of /project/slime/cvsroot/slime In directory common-lisp.net:/tmp/cvs-serv2896 Modified Files: swank-allegro.lisp Log Message: (default-directory, call-with-syntax-hooks): Add implementations as workarounds for ACL5 bugs. Date: Wed Jun 16 13:27:14 2004 Author: heller Index: slime/swank-allegro.lisp diff -u slime/swank-allegro.lisp:1.34 slime/swank-allegro.lisp:1.35 --- slime/swank-allegro.lisp:1.34 Sat Jun 12 05:27:29 2004 +++ slime/swank-allegro.lisp Wed Jun 16 13:27:14 2004 @@ -73,6 +73,12 @@ (namestring (setf *default-pathname-defaults* (truename (merge-pathnames directory))))) +(defimplementation default-directory () + (excl:chdir)) + +(defimplementation call-with-syntax-hooks (fn) + (funcall fn)) + ;;;; Misc (defimplementation arglist (symbol) From heller at common-lisp.net Wed Jun 16 20:28:30 2004 From: heller at common-lisp.net (Helmut Eller) Date: Wed, 16 Jun 2004 13:28:30 -0700 Subject: [slime-cvs] CVS update: slime/ChangeLog Message-ID: Update of /project/slime/cvsroot/slime In directory common-lisp.net:/tmp/cvs-serv5537 Modified Files: ChangeLog Log Message: *** empty log message *** Date: Wed Jun 16 13:28:30 2004 Author: heller Index: slime/ChangeLog diff -u slime/ChangeLog:1.395 slime/ChangeLog:1.396 --- slime/ChangeLog:1.395 Tue Jun 15 17:13:48 2004 +++ slime/ChangeLog Wed Jun 16 13:28:29 2004 @@ -1,3 +1,48 @@ +2004-06-16 Helmut Eller + + * slime.el (slime-set-default-directory): Don't call + slime-repl-update-banner in Emacs 20. + (slime-show-source-location, slime-recenter-window): Use + set-window-start instead of recenter; this avoids flickering. + (sldb-list-locals): Don't forget about slime-current-thread in the + temporary buffer. (Fixes bug reported by Mike Beedle.) + (sldb-step): Re-enabled. The CMUCL backend has rudimentary support + for stepping. + + * swank.lisp (*readtable-alist*): Call backend function for + initialization. + (eval-for-emacs, guess-buffer-package): Signal a continuable error + if a package name was supplied but no such package exists. Not + sure if this is better than what we did before (i.e. silently use + the current package). + + * swank-cmucl.lisp (default-directory): Add implementation. + (sldb-step): Uncomment it and remove references to + *swank-debugger-condition*. + + * swank-backend.lisp (sldb-step, default-readtable-alist): New + backend functions. + + * swank-sbcl.lisp (default-readtable-alist): Implement it. + + * swank-loader.lisp: Move readtable-alist initialization to + swank-sbcl.lisp. + + * swank-allegro.lisp (default-directory, call-with-syntax-hooks): + Add implementations as workarounds for ACL5 bugs. + +2004-06-16 Lawrence Mitchell + + * slime.el (slime-maybe-rearrange-inferior-lisp): Call + `generate-new-buffer-name' manually, rather than relying on the + UNIQUE argument to `rename-buffer' to do so. + +2004-06-16 Frederic Brunel + + * slime.el (slime-startup-animation): Use defcustom to declare the + variable. + (slime-enable-startup-animation-p): Deleted. + 2004-06-16 Robert Lehr * slime.el (slime-backend): This variable can now be set to an From elkegarouterod at canadian-mail.com Wed Jun 16 21:35:23 2004 From: elkegarouterod at canadian-mail.com (Avery Arroyo) Date: Wed, 16 Jun 2004 16:35:23 -0500 Subject: [slime-cvs] Subscriber p331: Stock-Market Trading System UP 145% in 2003, ID: s424dA61 Message-ID: An HTML attachment was scrubbed... URL: From heller at common-lisp.net Wed Jun 16 22:03:55 2004 From: heller at common-lisp.net (Helmut Eller) Date: Wed, 16 Jun 2004 15:03:55 -0700 Subject: [slime-cvs] CVS update: slime/swank-allegro.lisp Message-ID: Update of /project/slime/cvsroot/slime In directory common-lisp.net:/tmp/cvs-serv10616 Modified Files: swank-allegro.lisp Log Message: (emacs-connected): Pass the redirected stream as argument, so that the OpenMCL backend can add it to CCL::*AUTO-FLUSH-STREAMS*. Date: Wed Jun 16 15:03:55 2004 Author: heller Index: slime/swank-allegro.lisp diff -u slime/swank-allegro.lisp:1.35 slime/swank-allegro.lisp:1.36 --- slime/swank-allegro.lisp:1.35 Wed Jun 16 13:27:14 2004 +++ slime/swank-allegro.lisp Wed Jun 16 15:03:55 2004 @@ -48,7 +48,8 @@ ;; The following defitinions are workarounds for the buggy ;; no-applicable-method function in Allegro 5. We have to provide an ;; implementation. -(defimplementation emacs-connected ()) +(defimplementation emacs-connected (stream) + (declare (ignore stream))) (defimplementation format-sldb-condition (c) (princ-to-string c)) From heller at common-lisp.net Wed Jun 16 22:03:58 2004 From: heller at common-lisp.net (Helmut Eller) Date: Wed, 16 Jun 2004 15:03:58 -0700 Subject: [slime-cvs] CVS update: slime/swank-backend.lisp Message-ID: Update of /project/slime/cvsroot/slime In directory common-lisp.net:/tmp/cvs-serv10696 Modified Files: swank-backend.lisp Log Message: (emacs-connected): Pass the redirected stream as argument, so that the OpenMCL backend can add it to CCL::*AUTO-FLUSH-STREAMS*. Date: Wed Jun 16 15:03:58 2004 Author: heller Index: slime/swank-backend.lisp diff -u slime/swank-backend.lisp:1.52 slime/swank-backend.lisp:1.53 --- slime/swank-backend.lisp:1.52 Wed Jun 16 13:25:09 2004 +++ slime/swank-backend.lisp Wed Jun 16 15:03:58 2004 @@ -133,14 +133,17 @@ ;;; Base condition for networking errors. (define-condition network-error (simple-error) ()) -(definterface emacs-connected () +(definterface emacs-connected (stream) "Hook called when the first connection from Emacs is established. Called from the INIT-FN of the socket server that accepts the connection. This is intended for setting up extra context, e.g. to discover -that the calling thread is the one that interacts with Emacs." - nil) +that the calling thread is the one that interacts with Emacs. + +STREAM is the redirected user output stream to Emacs. This is passed +so that the backend can apply buffer flushing magic." + nil) ;;;; Unix signals From heller at common-lisp.net Wed Jun 16 22:04:01 2004 From: heller at common-lisp.net (Helmut Eller) Date: Wed, 16 Jun 2004 15:04:01 -0700 Subject: [slime-cvs] CVS update: slime/swank-lispworks.lisp Message-ID: Update of /project/slime/cvsroot/slime In directory common-lisp.net:/tmp/cvs-serv11408 Modified Files: swank-lispworks.lisp Log Message: (emacs-connected): Pass the redirected stream as argument, so that the OpenMCL backend can add it to CCL::*AUTO-FLUSH-STREAMS*. Date: Wed Jun 16 15:04:01 2004 Author: heller Index: slime/swank-lispworks.lisp diff -u slime/swank-lispworks.lisp:1.42 slime/swank-lispworks.lisp:1.43 --- slime/swank-lispworks.lisp:1.42 Wed Jun 9 05:40:52 2004 +++ slime/swank-lispworks.lisp Wed Jun 16 15:04:01 2004 @@ -64,7 +64,8 @@ (sys::set-signal-handler +sigint+ (make-sigint-handler mp:*current-process*))) -(defimplementation emacs-connected () +(defimplementation emacs-connected (stream) + (declare (ignore stream)) (set-sigint-handler) (let ((lw:*handle-warn-on-redefinition* :warn)) (defmethod stream:stream-soft-force-output ((o comm:socket-stream)) @@ -226,10 +227,10 @@ (push frame backtrace))))) (defun frame-actual-args (frame) - (mapcar (lambda (arg) - (handler-case (dbg::dbg-eval arg frame) - (error (format nil "<~A>" arg)))) - (dbg::call-frame-arglist frame))) + (mapcar (lambda (arg) + (handler-case (dbg::dbg-eval arg frame) + (error (format nil "<~A>" arg)))) + (dbg::call-frame-arglist frame))) (defimplementation print-frame (frame stream) (cond ((dbg::call-frame-p frame) @@ -475,7 +476,7 @@ (loop for object across callers collect (if (symbolp object) (list 'function object) - (dspec:object-dspec object))))) + (dspec:object-dspec object))))) ;; only for lispworks 4.2 and above #-lispworks4.1 From heller at common-lisp.net Wed Jun 16 22:04:05 2004 From: heller at common-lisp.net (Helmut Eller) Date: Wed, 16 Jun 2004 15:04:05 -0700 Subject: [slime-cvs] CVS update: slime/swank-openmcl.lisp Message-ID: Update of /project/slime/cvsroot/slime In directory common-lisp.net:/tmp/cvs-serv12207 Modified Files: swank-openmcl.lisp Log Message: (emacs-connected): Pass the redirected stream as argument, so that the OpenMCL backend can add it to CCL::*AUTO-FLUSH-STREAMS*. Date: Wed Jun 16 15:04:04 2004 Author: heller Index: slime/swank-openmcl.lisp diff -u slime/swank-openmcl.lisp:1.76 slime/swank-openmcl.lisp:1.77 --- slime/swank-openmcl.lisp:1.76 Sat Jun 12 05:01:23 2004 +++ slime/swank-openmcl.lisp Wed Jun 16 15:04:04 2004 @@ -85,8 +85,9 @@ (defimplementation accept-connection (socket) (ccl:accept-connection socket :wait t)) -(defimplementation emacs-connected () - (setq ccl::*interactive-abort-process* ccl::*current-process*)) +(defimplementation emacs-connected (stream) + (setq ccl::*interactive-abort-process* ccl::*current-process*) + (push stream ccl::*auto-flush-streams*)) ;;; Unix signals From heller at common-lisp.net Wed Jun 16 22:04:09 2004 From: heller at common-lisp.net (Helmut Eller) Date: Wed, 16 Jun 2004 15:04:09 -0700 Subject: [slime-cvs] CVS update: slime/swank.lisp Message-ID: Update of /project/slime/cvsroot/slime In directory common-lisp.net:/tmp/cvs-serv12447 Modified Files: swank.lisp Log Message: (emacs-connected): Pass the redirected stream as argument, so that the OpenMCL backend can add it to CCL::*AUTO-FLUSH-STREAMS*. Date: Wed Jun 16 15:04:09 2004 Author: heller Index: slime/swank.lisp diff -u slime/swank.lisp:1.191 slime/swank.lisp:1.192 --- slime/swank.lisp:1.191 Wed Jun 16 13:26:58 2004 +++ slime/swank.lisp Wed Jun 16 15:04:09 2004 @@ -270,8 +270,7 @@ (funcall (connection.serve-requests connection) connection)) (defun init-emacs-connection (connection) - (declare (ignore connection)) - (emacs-connected)) + (emacs-connected (connection.user-io connection))) (defun announce-server-port (file port) (with-open-file (s file From heller at common-lisp.net Wed Jun 16 22:04:56 2004 From: heller at common-lisp.net (Helmut Eller) Date: Wed, 16 Jun 2004 15:04:56 -0700 Subject: [slime-cvs] CVS update: slime/swank-abcl.lisp Message-ID: Update of /project/slime/cvsroot/slime In directory common-lisp.net:/tmp/cvs-serv13560 Modified Files: swank-abcl.lisp Log Message: (emacs-connected): Ignore the stream argument. Date: Wed Jun 16 15:04:56 2004 Author: heller Index: slime/swank-abcl.lisp diff -u slime/swank-abcl.lisp:1.2 slime/swank-abcl.lisp:1.3 --- slime/swank-abcl.lisp:1.2 Wed Jun 16 12:39:06 2004 +++ slime/swank-abcl.lisp Wed Jun 16 15:04:56 2004 @@ -55,10 +55,9 @@ (defimplementation accept-connection (socket) (ext:get-socket-stream (ext:socket-accept socket))) - - -(defimplementation emacs-connected ()) +(defimplementation emacs-connected (stream) + (declare (ignore stream))) ;;;; Unix signals From heller at common-lisp.net Wed Jun 16 22:05:27 2004 From: heller at common-lisp.net (Helmut Eller) Date: Wed, 16 Jun 2004 15:05:27 -0700 Subject: [slime-cvs] CVS update: slime/ChangeLog Message-ID: Update of /project/slime/cvsroot/slime In directory common-lisp.net:/tmp/cvs-serv14694 Modified Files: ChangeLog Log Message: *** empty log message *** Date: Wed Jun 16 15:05:27 2004 Author: heller Index: slime/ChangeLog diff -u slime/ChangeLog:1.396 slime/ChangeLog:1.397 --- slime/ChangeLog:1.396 Wed Jun 16 13:28:29 2004 +++ slime/ChangeLog Wed Jun 16 15:05:27 2004 @@ -22,6 +22,8 @@ * swank-backend.lisp (sldb-step, default-readtable-alist): New backend functions. + (emacs-connected): Pass the redirected stream as argument, so that + the OpenMCL backend can add it to CCL::*AUTO-FLUSH-STREAMS*. * swank-sbcl.lisp (default-readtable-alist): Implement it. From zxqoc at yahoo.com Thu Jun 17 07:46:10 2004 From: zxqoc at yahoo.com (Ricardo Rush) Date: Thu, 17 Jun 2004 09:46:10 +0200 Subject: [slime-cvs] Fw: he's just back in the office Message-ID: <677953693424184.43471@zxqoc@yahoo.com> An HTML attachment was scrubbed... URL: From lgorrie at common-lisp.net Thu Jun 17 10:10:48 2004 From: lgorrie at common-lisp.net (Luke Gorrie) Date: Thu, 17 Jun 2004 03:10:48 -0700 Subject: [slime-cvs] CVS update: slime/swank-lispworks.lisp Message-ID: Update of /project/slime/cvsroot/slime In directory common-lisp.net:/tmp/cvs-serv2294 Modified Files: swank-lispworks.lisp Log Message: (dspec-stream-position): Remove `with-standard-io-syntax' so that we can read files with custom read syntax. Bind *READ-EVAL* to T instead of NIL (at the suggestion of Alain Picard). Date: Thu Jun 17 03:10:48 2004 Author: lgorrie Index: slime/swank-lispworks.lisp diff -u slime/swank-lispworks.lisp:1.43 slime/swank-lispworks.lisp:1.44 --- slime/swank-lispworks.lisp:1.43 Wed Jun 16 15:04:01 2004 +++ slime/swank-lispworks.lisp Thu Jun 17 03:10:48 2004 @@ -348,31 +348,30 @@ #-(or lispworks-4.1 lispworks-4.2) ; no dspec:parse-form-dspec prior to 4.3 (defun dspec-stream-position (stream dspec) - (with-standard-io-syntax - (let ((*read-eval* nil)) - (loop (let* ((pos (file-position stream)) - (form (read stream nil '#1=#:eof))) - (when (eq form '#1#) - (return nil)) - (labels ((check-dspec (form) - (when (consp form) - (let ((operator (car form))) - (case operator - ((progn) - (mapcar #'check-dspec - (cdr form))) - ((eval-when locally macrolet symbol-macrolet) - (mapcar #'check-dspec - (cddr form))) - ((in-package) - (let ((package (find-package (second form)))) - (when package - (setq *package* package)))) - (otherwise - (let ((form-dspec (dspec:parse-form-dspec form))) - (when (dspec:dspec-equal dspec form-dspec) - (return pos))))))))) - (check-dspec form))))))) + (let ((*read-eval* t)) + (loop (let* ((pos (file-position stream)) + (form (read stream nil '#1=#:eof))) + (when (eq form '#1#) + (return nil)) + (labels ((check-dspec (form) + (when (consp form) + (let ((operator (car form))) + (case operator + ((progn) + (mapcar #'check-dspec + (cdr form))) + ((eval-when locally macrolet symbol-macrolet) + (mapcar #'check-dspec + (cddr form))) + ((in-package) + (let ((package (find-package (second form)))) + (when package + (setq *package* package)))) + (otherwise + (let ((form-dspec (dspec:parse-form-dspec form))) + (when (dspec:dspec-equal dspec form-dspec) + (return pos))))))))) + (check-dspec form)))))) (defun emacs-buffer-location-p (location) (and (consp location) From lgorrie at common-lisp.net Thu Jun 17 10:10:56 2004 From: lgorrie at common-lisp.net (Luke Gorrie) Date: Thu, 17 Jun 2004 03:10:56 -0700 Subject: [slime-cvs] CVS update: slime/ChangeLog Message-ID: Update of /project/slime/cvsroot/slime In directory common-lisp.net:/tmp/cvs-serv2401 Modified Files: ChangeLog Log Message: Date: Thu Jun 17 03:10:56 2004 Author: lgorrie Index: slime/ChangeLog diff -u slime/ChangeLog:1.397 slime/ChangeLog:1.398 --- slime/ChangeLog:1.397 Wed Jun 16 15:05:27 2004 +++ slime/ChangeLog Thu Jun 17 03:10:56 2004 @@ -1,3 +1,11 @@ +2004-06-17 Luke Gorrie + + * swank-lispworks.lisp (dspec-stream-position): Remove + `with-standard-io-syntax' so that we can read files with custom + read syntax. + Bind *READ-EVAL* to T instead of NIL (at the suggestion of Alain + Picard). + 2004-06-16 Helmut Eller * slime.el (slime-set-default-directory): Don't call From lgorrie at common-lisp.net Thu Jun 17 11:39:29 2004 From: lgorrie at common-lisp.net (Luke Gorrie) Date: Thu, 17 Jun 2004 04:39:29 -0700 Subject: [slime-cvs] CVS update: slime/swank-lispworks.lisp Message-ID: Update of /project/slime/cvsroot/slime In directory common-lisp.net:/tmp/cvs-serv25308 Modified Files: swank-lispworks.lisp Log Message: (with-fairly-standard-io-syntax): New macro. Like with-standard-io-syntax, but keeps the existing values of *package* and *readtable*. (dspec-stream-position): Use it. Date: Thu Jun 17 04:39:28 2004 Author: lgorrie Index: slime/swank-lispworks.lisp diff -u slime/swank-lispworks.lisp:1.44 slime/swank-lispworks.lisp:1.45 --- slime/swank-lispworks.lisp:1.44 Thu Jun 17 03:10:48 2004 +++ slime/swank-lispworks.lisp Thu Jun 17 04:39:27 2004 @@ -346,9 +346,20 @@ (null (list :position offset)) (symbol (list :function-name (string dspec))))) +(defmacro with-fairly-standard-io-syntax (&body body) + "Like WITH-STANDARD-IO-SYNTAX but preserve *PACKAGE* and *READTABLE*." + (let ((package (gensym)) + (readtable (gensym))) + `(let ((,package *package*) + (,readtable *readtable*)) + (with-standard-io-syntax + (let ((*package* ,package) + (*readtable* ,readtable)) + , at body))))) + #-(or lispworks-4.1 lispworks-4.2) ; no dspec:parse-form-dspec prior to 4.3 (defun dspec-stream-position (stream dspec) - (let ((*read-eval* t)) + (with-fairly-standard-io-syntax (loop (let* ((pos (file-position stream)) (form (read stream nil '#1=#:eof))) (when (eq form '#1#) From lgorrie at common-lisp.net Thu Jun 17 11:39:36 2004 From: lgorrie at common-lisp.net (Luke Gorrie) Date: Thu, 17 Jun 2004 04:39:36 -0700 Subject: [slime-cvs] CVS update: slime/ChangeLog Message-ID: Update of /project/slime/cvsroot/slime In directory common-lisp.net:/tmp/cvs-serv25426 Modified Files: ChangeLog Log Message: Date: Thu Jun 17 04:39:36 2004 Author: lgorrie Index: slime/ChangeLog diff -u slime/ChangeLog:1.398 slime/ChangeLog:1.399 --- slime/ChangeLog:1.398 Thu Jun 17 03:10:56 2004 +++ slime/ChangeLog Thu Jun 17 04:39:36 2004 @@ -1,10 +1,9 @@ 2004-06-17 Luke Gorrie - * swank-lispworks.lisp (dspec-stream-position): Remove - `with-standard-io-syntax' so that we can read files with custom - read syntax. - Bind *READ-EVAL* to T instead of NIL (at the suggestion of Alain - Picard). + * swank-lispworks.lisp (with-fairly-standard-io-syntax): New + macro. Like with-standard-io-syntax, but keeps the existing values + of *package* and *readtable*. + (dspec-stream-position): Use it. 2004-06-16 Helmut Eller From lgorrie at common-lisp.net Thu Jun 17 15:59:46 2004 From: lgorrie at common-lisp.net (Luke Gorrie) Date: Thu, 17 Jun 2004 08:59:46 -0700 Subject: [slime-cvs] CVS update: slime/swank-lispworks.lisp Message-ID: Update of /project/slime/cvsroot/slime In directory common-lisp.net:/tmp/cvs-serv23586 Modified Files: swank-lispworks.lisp Log Message: (quit-lisp): Implemented. Date: Thu Jun 17 08:59:46 2004 Author: lgorrie Index: slime/swank-lispworks.lisp diff -u slime/swank-lispworks.lisp:1.45 slime/swank-lispworks.lisp:1.46 --- slime/swank-lispworks.lisp:1.45 Thu Jun 17 04:39:27 2004 +++ slime/swank-lispworks.lisp Thu Jun 17 08:59:46 2004 @@ -514,6 +514,11 @@ (values (format nil "~A~% is a ~A" o type) (mapcar #'cons names values)))) +;;; Miscellaneous + +(defimplementation quit-lisp () + (lispworks:quit)) + ;;; Multithreading (defimplementation startup-multiprocessing () From lgorrie at common-lisp.net Thu Jun 17 16:04:52 2004 From: lgorrie at common-lisp.net (Luke Gorrie) Date: Thu, 17 Jun 2004 09:04:52 -0700 Subject: [slime-cvs] CVS update: slime/swank-loader.lisp Message-ID: Update of /project/slime/cvsroot/slime In directory common-lisp.net:/tmp/cvs-serv4785 Modified Files: swank-loader.lisp Log Message: (binary-pathname): Place fasl files under ~/.slime/fasl/ (or _slime in win32) instead of the SLIME installation directory. The installation directory can now be read-only. Date: Thu Jun 17 09:04:52 2004 Author: lgorrie Index: slime/swank-loader.lisp diff -u slime/swank-loader.lisp:1.26 slime/swank-loader.lisp:1.27 --- slime/swank-loader.lisp:1.26 Wed Jun 16 13:25:46 2004 +++ slime/swank-loader.lisp Thu Jun 17 09:04:52 2004 @@ -58,9 +58,15 @@ (> (file-write-date new-file) (file-write-date old-file))) (defun binary-pathname (source-pathname) - (merge-pathnames - (make-pathname :directory `(:relative "fasl" ,*lisp-name*)) - (merge-pathnames (compile-file-pathname source-pathname)))) + "Return the pathname where SOURCE-PATHNAME's binary should be compiled." + (let ((cfp (compile-file-pathname source-pathname))) + (merge-pathnames (make-pathname + :directory `(:relative #-mswindows ".slime" + #+mswindows "_slime" + "fasl" ,*lisp-name*) + :name (pathname-name cfp) + :type (pathname-type cfp)) + (user-homedir-pathname)))) (defun compile-files-if-needed-serially (files) "Compile each file in FILES if the source is newer than From lgorrie at common-lisp.net Thu Jun 17 16:05:02 2004 From: lgorrie at common-lisp.net (Luke Gorrie) Date: Thu, 17 Jun 2004 09:05:02 -0700 Subject: [slime-cvs] CVS update: slime/ChangeLog Message-ID: Update of /project/slime/cvsroot/slime In directory common-lisp.net:/tmp/cvs-serv5227 Modified Files: ChangeLog Log Message: Date: Thu Jun 17 09:05:02 2004 Author: lgorrie Index: slime/ChangeLog diff -u slime/ChangeLog:1.399 slime/ChangeLog:1.400 --- slime/ChangeLog:1.399 Thu Jun 17 04:39:36 2004 +++ slime/ChangeLog Thu Jun 17 09:05:02 2004 @@ -1,9 +1,15 @@ 2004-06-17 Luke Gorrie + * swank-loader.lisp (binary-pathname): Place fasl files under + ~/.slime/fasl/ (or _slime in win32) instead of the SLIME + installation directory. The installation directory can now be + read-only. + * swank-lispworks.lisp (with-fairly-standard-io-syntax): New macro. Like with-standard-io-syntax, but keeps the existing values of *package* and *readtable*. (dspec-stream-position): Use it. + (quit-lisp): Implemented. 2004-06-16 Helmut Eller From lgorrie at common-lisp.net Thu Jun 17 17:41:16 2004 From: lgorrie at common-lisp.net (Luke Gorrie) Date: Thu, 17 Jun 2004 10:41:16 -0700 Subject: [slime-cvs] CVS update: slime/swank-loader.lisp Message-ID: Update of /project/slime/cvsroot/slime In directory common-lisp.net:/tmp/cvs-serv25400 Modified Files: swank-loader.lisp Log Message: (binary-pathname, user-init-file): Removed Win32 conditionalization. The init file is now called ~/.swank.lisp instead of ~/_swank.lsp. Date: Thu Jun 17 10:41:16 2004 Author: lgorrie Index: slime/swank-loader.lisp diff -u slime/swank-loader.lisp:1.27 slime/swank-loader.lisp:1.28 --- slime/swank-loader.lisp:1.27 Thu Jun 17 09:04:52 2004 +++ slime/swank-loader.lisp Thu Jun 17 10:41:16 2004 @@ -61,9 +61,8 @@ "Return the pathname where SOURCE-PATHNAME's binary should be compiled." (let ((cfp (compile-file-pathname source-pathname))) (merge-pathnames (make-pathname - :directory `(:relative #-mswindows ".slime" - #+mswindows "_slime" - "fasl" ,*lisp-name*) + :directory `(:relative + ".slime" "fasl" ,*lisp-name*) :name (pathname-name cfp) :type (pathname-type cfp)) (user-homedir-pathname)))) @@ -97,8 +96,7 @@ "Return the name of the user init file or nil." (probe-file (merge-pathnames (user-homedir-pathname) - #-mswindows (make-pathname :name ".swank" :type "lisp") - #+mswindows (make-pathname :name "_swank" :type "lsp")))) + (make-pathname :name ".swank" :type "lisp")))) (compile-files-if-needed-serially From lgorrie at common-lisp.net Thu Jun 17 17:42:39 2004 From: lgorrie at common-lisp.net (Luke Gorrie) Date: Thu, 17 Jun 2004 10:42:39 -0700 Subject: [slime-cvs] CVS update: slime/ChangeLog Message-ID: Update of /project/slime/cvsroot/slime In directory common-lisp.net:/tmp/cvs-serv5568 Modified Files: ChangeLog Log Message: Date: Thu Jun 17 10:42:39 2004 Author: lgorrie Index: slime/ChangeLog diff -u slime/ChangeLog:1.400 slime/ChangeLog:1.401 --- slime/ChangeLog:1.400 Thu Jun 17 09:05:02 2004 +++ slime/ChangeLog Thu Jun 17 10:42:39 2004 @@ -1,9 +1,11 @@ 2004-06-17 Luke Gorrie * swank-loader.lisp (binary-pathname): Place fasl files under - ~/.slime/fasl/ (or _slime in win32) instead of the SLIME - installation directory. The installation directory can now be - read-only. + ~/.slime/fasl/ instead of the SLIME installation directory. The + installation directory can now be read-only. + (binary-pathname, user-init-file): Removed Win32 + conditionalization. The init file is now called ~/.swank.lisp + instead of ~/_swank.lsp. * swank-lispworks.lisp (with-fairly-standard-io-syntax): New macro. Like with-standard-io-syntax, but keeps the existing values From vasilibyrnsrod at animationemail.com Fri Jun 18 00:15:08 2004 From: vasilibyrnsrod at animationemail.com (Lena Gifford) Date: Thu, 17 Jun 2004 19:15:08 -0500 Subject: [slime-cvs] l70 - F-REE Pay-Per-View w/Our Cable-TV Filter, ID: E339Ss71 Message-ID: An HTML attachment was scrubbed... URL: From lgorrie at common-lisp.net Fri Jun 18 16:10:23 2004 From: lgorrie at common-lisp.net (Luke Gorrie) Date: Fri, 18 Jun 2004 09:10:23 -0700 Subject: [slime-cvs] CVS update: slime/slime.el Message-ID: Update of /project/slime/cvsroot/slime In directory common-lisp.net:/tmp/cvs-serv10215 Modified Files: slime.el Log Message: (slime-repl-return): If the user presses return on old REPL input then take it and insert it as the current input. Signal an error if the point is not on any input. Date: Fri Jun 18 09:10:22 2004 Author: lgorrie Index: slime/slime.el diff -u slime/slime.el:1.315 slime/slime.el:1.316 --- slime/slime.el:1.315 Wed Jun 16 13:24:56 2004 +++ slime/slime.el Fri Jun 18 09:10:22 2004 @@ -2307,15 +2307,14 @@ (interactive) (slime-check-connected) (assert (<= (point) slime-repl-input-end-mark)) - (cond (current-prefix-arg + (cond ((get-text-property (point) 'slime-repl-old-input) + (slime-repl-grab-old-input)) + (current-prefix-arg (slime-repl-send-input)) (slime-repl-read-mode ; bad style? - (insert "\n") (slime-repl-send-input)) ((slime-input-complete-p slime-repl-input-start-mark slime-repl-input-end-mark) - (goto-char slime-repl-input-end-mark) - (insert "\n") (slime-repl-send-input)) (t (slime-repl-newline-and-indent) @@ -2323,13 +2322,39 @@ (defun slime-repl-send-input () "Goto to the end of the input and send the current input." + (when (< (point) slime-repl-input-start-mark) + (error "No input at point.")) (let ((input (slime-repl-current-input))) (goto-char slime-repl-input-end-mark) + (insert "\n") (add-text-properties slime-repl-input-start-mark (point) - '(face slime-repl-input-face rear-nonsticky (face))) + '(face slime-repl-input-face + rear-nonsticky (face) + slime-repl-old-input t)) (slime-mark-input-start) (slime-mark-output-start) (slime-repl-send-string input))) + +(defun slime-repl-grab-old-input () + "Resend the old REPL input at point. +The old input has the text property `slime-repl-old-input'." + (let ((prop 'slime-repl-old-input)) + (let* ((beg (save-excursion + ;; previous-single-char-property-change searches for + ;; a property change from the previous character, + ;; but we want to look for a change from the + ;; point. We step forward one char to avoid doing + ;; the wrong thing if we're at the beginning of the + ;; old input. -luke (18/Jun/2004) + (ignore-errors (forward-char)) + (previous-single-char-property-change (point) prop))) + (end (next-single-char-property-change (point) prop)) + (old-input (buffer-substring beg end))) + (goto-char slime-repl-input-start-mark) + (delete-region (point) slime-repl-input-end-mark) + (insert old-input) + (while (eq (char-before) ?\n) + (delete-char -1))))) (defun slime-repl-closing-return () "Evaluate the current input string after closing all open lists." From lgorrie at common-lisp.net Fri Jun 18 16:10:49 2004 From: lgorrie at common-lisp.net (Luke Gorrie) Date: Fri, 18 Jun 2004 09:10:49 -0700 Subject: [slime-cvs] CVS update: slime/ChangeLog Message-ID: Update of /project/slime/cvsroot/slime In directory common-lisp.net:/tmp/cvs-serv10382 Modified Files: ChangeLog Log Message: Date: Fri Jun 18 09:10:49 2004 Author: lgorrie Index: slime/ChangeLog diff -u slime/ChangeLog:1.401 slime/ChangeLog:1.402 --- slime/ChangeLog:1.401 Thu Jun 17 10:42:39 2004 +++ slime/ChangeLog Fri Jun 18 09:10:49 2004 @@ -1,3 +1,9 @@ +2004-06-18 Luke Gorrie + + * slime.el (slime-repl-return): If the user presses return on old + REPL input then take it and insert it as the current input. + Signal an error if the point is not on any input. + 2004-06-17 Luke Gorrie * swank-loader.lisp (binary-pathname): Place fasl files under From lgorrie at common-lisp.net Fri Jun 18 16:45:33 2004 From: lgorrie at common-lisp.net (Luke Gorrie) Date: Fri, 18 Jun 2004 09:45:33 -0700 Subject: [slime-cvs] CVS update: slime/slime.el Message-ID: Update of /project/slime/cvsroot/slime In directory common-lisp.net:/tmp/cvs-serv14726 Modified Files: slime.el Log Message: (slime-preserve-zmacs-region): Function to ensure that the current command doesn't deactive zmacs-region (XEmacs only). (slime-repl-bol, slime-repl-eol): Use it. (slime-kill-all-buffers): Changed buffer-name regexps for XEmacs compatibility. The ",quit" shortcut now works in XEmacs. Date: Fri Jun 18 09:45:33 2004 Author: lgorrie Index: slime/slime.el diff -u slime/slime.el:1.316 slime/slime.el:1.317 --- slime/slime.el:1.316 Fri Jun 18 09:10:22 2004 +++ slime/slime.el Fri Jun 18 09:45:33 2004 @@ -2235,7 +2235,8 @@ (if (and (>= (point) slime-repl-input-start-mark) (slime-same-line-p (point) slime-repl-input-start-mark)) (goto-char slime-repl-input-start-mark) - (beginning-of-line 1))) + (beginning-of-line 1)) + (slime-preserve-zmacs-region)) (defun slime-repl-eol () "Go to the end of line or the prompt." @@ -2243,7 +2244,13 @@ (if (and (<= (point) slime-repl-input-end-mark) (slime-same-line-p (point) slime-repl-input-end-mark)) (goto-char slime-repl-input-end-mark) - (end-of-line 1))) + (end-of-line 1)) + (slime-preserve-zmacs-region)) + +(defun slime-preserve-zmacs-region () + "In XEmacs, ensure that the zmacs-region stays active after this command." + (when (boundp 'zmacs-region-stays) + (set 'zmacs-region-stays t))) (defun slime-repl-in-input-area-p () (and (<= slime-repl-input-start-mark (point)) @@ -6264,8 +6271,8 @@ (dolist (buf (buffer-list)) (when (or (member (buffer-name buf) '("*inferior-lisp*" slime-event-buffer-name)) - (string-match "\*slime-repl\[\d+\]\*" (buffer-name buf)) - (string-match "\*sldb .*\*" (buffer-name buf))) + (string-match "^\\*slime-repl\\[[0-9]+\\]\\*$" (buffer-name buf)) + (string-match "^\\*sldb .*\\*$" (buffer-name buf))) (kill-buffer buf)))) From lgorrie at common-lisp.net Fri Jun 18 16:46:42 2004 From: lgorrie at common-lisp.net (Luke Gorrie) Date: Fri, 18 Jun 2004 09:46:42 -0700 Subject: [slime-cvs] CVS update: slime/ChangeLog Message-ID: Update of /project/slime/cvsroot/slime In directory common-lisp.net:/tmp/cvs-serv17133 Modified Files: ChangeLog Log Message: Date: Fri Jun 18 09:46:42 2004 Author: lgorrie Index: slime/ChangeLog diff -u slime/ChangeLog:1.402 slime/ChangeLog:1.403 --- slime/ChangeLog:1.402 Fri Jun 18 09:10:49 2004 +++ slime/ChangeLog Fri Jun 18 09:46:42 2004 @@ -3,6 +3,11 @@ * slime.el (slime-repl-return): If the user presses return on old REPL input then take it and insert it as the current input. Signal an error if the point is not on any input. + (slime-preserve-zmacs-region): Function to ensure that the current + command doesn't deactive zmacs-region (XEmacs only). + (slime-repl-bol, slime-repl-eol): Use it. + (slime-kill-all-buffers): Changed buffer-name regexps for XEmacs + compatibility. The ",quit" shortcut now works in XEmacs. 2004-06-17 Luke Gorrie From lgorrie at common-lisp.net Fri Jun 18 17:43:15 2004 From: lgorrie at common-lisp.net (Luke Gorrie) Date: Fri, 18 Jun 2004 10:43:15 -0700 Subject: [slime-cvs] CVS update: slime/slime.el Message-ID: Update of /project/slime/cvsroot/slime In directory common-lisp.net:/tmp/cvs-serv12698 Modified Files: slime.el Log Message: (slime-display-message): Fixed call to `slime-typeout-message' handle formatting characters. Avoids errors on certain messages. Date: Fri Jun 18 10:43:15 2004 Author: lgorrie Index: slime/slime.el diff -u slime/slime.el:1.317 slime/slime.el:1.318 --- slime/slime.el:1.317 Fri Jun 18 09:45:33 2004 +++ slime/slime.el Fri Jun 18 10:43:14 2004 @@ -800,7 +800,7 @@ (cond ((or (string-match "\n" message) (> (length message) (1- (frame-width)))) (if (slime-typeout-active-p) - (slime-typeout-message message) + (slime-typeout-message "%s" message) (lexical-let ((buffer (get-buffer-create buffer-name))) (with-current-buffer buffer (erase-buffer) From lgorrie at common-lisp.net Fri Jun 18 17:43:26 2004 From: lgorrie at common-lisp.net (Luke Gorrie) Date: Fri, 18 Jun 2004 10:43:26 -0700 Subject: [slime-cvs] CVS update: slime/ChangeLog Message-ID: Update of /project/slime/cvsroot/slime In directory common-lisp.net:/tmp/cvs-serv14183 Modified Files: ChangeLog Log Message: Date: Fri Jun 18 10:43:26 2004 Author: lgorrie Index: slime/ChangeLog diff -u slime/ChangeLog:1.403 slime/ChangeLog:1.404 --- slime/ChangeLog:1.403 Fri Jun 18 09:46:42 2004 +++ slime/ChangeLog Fri Jun 18 10:43:25 2004 @@ -8,6 +8,8 @@ (slime-repl-bol, slime-repl-eol): Use it. (slime-kill-all-buffers): Changed buffer-name regexps for XEmacs compatibility. The ",quit" shortcut now works in XEmacs. + (slime-display-message): Fixed call to `slime-typeout-message' + handle formatting characters. Avoids errors on certain messages. 2004-06-17 Luke Gorrie From lgorrie at common-lisp.net Fri Jun 18 17:50:03 2004 From: lgorrie at common-lisp.net (Luke Gorrie) Date: Fri, 18 Jun 2004 10:50:03 -0700 Subject: [slime-cvs] CVS update: slime/slime.el Message-ID: Update of /project/slime/cvsroot/slime In directory common-lisp.net:/tmp/cvs-serv5471 Modified Files: slime.el Log Message: (slime-list-compiler-notes): Save the window configuration earlier. This fixes an error under XEmacs when dismissing the notes buffer. Date: Fri Jun 18 10:50:03 2004 Author: lgorrie Index: slime/slime.el diff -u slime/slime.el:1.318 slime/slime.el:1.319 --- slime/slime.el:1.318 Fri Jun 18 10:43:14 2004 +++ slime/slime.el Fri Jun 18 10:50:03 2004 @@ -2858,7 +2858,10 @@ (defun slime-list-compiler-notes (&optional notes) "Show the compiler notes NOTES in tree view." (interactive) - (let ((notes (or notes (slime-compiler-notes)))) + (let ((notes (or notes (slime-compiler-notes))) + ;; We have to grab the window configuration before switching + ;; buffers in XEmacs. + (window-config (current-window-configuration))) (with-current-buffer (get-buffer-create "*compiler notes*") (let ((inhibit-read-only t)) (erase-buffer) @@ -2871,7 +2874,7 @@ (setq buffer-read-only t) (make-local-variable 'slime-compiler-notes-saved-window-configuration) (setq slime-compiler-notes-saved-window-configuration - (current-window-configuration)) + window-config) (goto-char (point-min)) (pop-to-buffer (current-buffer))))) From lgorrie at common-lisp.net Fri Jun 18 17:50:10 2004 From: lgorrie at common-lisp.net (Luke Gorrie) Date: Fri, 18 Jun 2004 10:50:10 -0700 Subject: [slime-cvs] CVS update: slime/ChangeLog Message-ID: Update of /project/slime/cvsroot/slime In directory common-lisp.net:/tmp/cvs-serv6237 Modified Files: ChangeLog Log Message: Date: Fri Jun 18 10:50:10 2004 Author: lgorrie Index: slime/ChangeLog diff -u slime/ChangeLog:1.404 slime/ChangeLog:1.405 --- slime/ChangeLog:1.404 Fri Jun 18 10:43:25 2004 +++ slime/ChangeLog Fri Jun 18 10:50:10 2004 @@ -10,6 +10,9 @@ compatibility. The ",quit" shortcut now works in XEmacs. (slime-display-message): Fixed call to `slime-typeout-message' handle formatting characters. Avoids errors on certain messages. + (slime-list-compiler-notes): Save the window configuration + earlier. This fixes an error under XEmacs when dismissing the + notes buffer. 2004-06-17 Luke Gorrie From lgorrie at common-lisp.net Fri Jun 18 17:53:03 2004 From: lgorrie at common-lisp.net (Luke Gorrie) Date: Fri, 18 Jun 2004 10:53:03 -0700 Subject: [slime-cvs] CVS update: slime/ChangeLog Message-ID: Update of /project/slime/cvsroot/slime In directory common-lisp.net:/tmp/cvs-serv29983 Modified Files: ChangeLog Log Message: *** empty log message *** Date: Fri Jun 18 10:53:03 2004 Author: lgorrie Index: slime/ChangeLog diff -u slime/ChangeLog:1.405 slime/ChangeLog:1.406 --- slime/ChangeLog:1.405 Fri Jun 18 10:50:10 2004 +++ slime/ChangeLog Fri Jun 18 10:53:03 2004 @@ -4,12 +4,12 @@ REPL input then take it and insert it as the current input. Signal an error if the point is not on any input. (slime-preserve-zmacs-region): Function to ensure that the current - command doesn't deactive zmacs-region (XEmacs only). + command doesn't deactivate zmacs-region (XEmacs only). (slime-repl-bol, slime-repl-eol): Use it. (slime-kill-all-buffers): Changed buffer-name regexps for XEmacs compatibility. The ",quit" shortcut now works in XEmacs. (slime-display-message): Fixed call to `slime-typeout-message' - handle formatting characters. Avoids errors on certain messages. + to handle formatting characters. Avoids errors on certain messages. (slime-list-compiler-notes): Save the window configuration earlier. This fixes an error under XEmacs when dismissing the notes buffer. From lgorrie at common-lisp.net Fri Jun 18 19:26:05 2004 From: lgorrie at common-lisp.net (Luke Gorrie) Date: Fri, 18 Jun 2004 12:26:05 -0700 Subject: [slime-cvs] CVS update: slime/ChangeLog Message-ID: Update of /project/slime/cvsroot/slime In directory common-lisp.net:/tmp/cvs-serv24850 Modified Files: ChangeLog Log Message: (slime-recenter-window): Avoid moving the point. This the keeps the point in the right place when showing debugger-frame locations in Emacs 21. Date: Fri Jun 18 12:26:05 2004 Author: lgorrie Index: slime/ChangeLog diff -u slime/ChangeLog:1.406 slime/ChangeLog:1.407 --- slime/ChangeLog:1.406 Fri Jun 18 10:53:03 2004 +++ slime/ChangeLog Fri Jun 18 12:26:04 2004 @@ -1,3 +1,8 @@ +2004-06-18 Matthew Danish + + * swank-allegro.lisp (frame-source-location-for-emacs): + Implemented. + 2004-06-18 Luke Gorrie * slime.el (slime-repl-return): If the user presses return on old @@ -13,6 +18,9 @@ (slime-list-compiler-notes): Save the window configuration earlier. This fixes an error under XEmacs when dismissing the notes buffer. + (slime-recenter-window): Avoid moving the point. This puts the + keeps the point in the right place when showing debugger-frame + locations in Emacs 21. 2004-06-17 Luke Gorrie From lgorrie at common-lisp.net Fri Jun 18 19:26:12 2004 From: lgorrie at common-lisp.net (Luke Gorrie) Date: Fri, 18 Jun 2004 12:26:12 -0700 Subject: [slime-cvs] CVS update: slime/slime.el Message-ID: Update of /project/slime/cvsroot/slime In directory common-lisp.net:/tmp/cvs-serv25323 Modified Files: slime.el Log Message: (slime-recenter-window): Avoid moving the point. This the keeps the point in the right place when showing debugger-frame locations in Emacs 21. Date: Fri Jun 18 12:26:12 2004 Author: lgorrie Index: slime/slime.el diff -u slime/slime.el:1.319 slime/slime.el:1.320 --- slime/slime.el:1.319 Fri Jun 18 10:50:03 2004 +++ slime/slime.el Fri Jun 18 12:26:12 2004 @@ -5071,13 +5071,13 @@ (defun slime-recenter-window (window line) "Set window-start in WINDOW LINE lines before point." - (let ((line (if (not line) - (/ (window-height window) 2) - line))) - (let ((start (ignore-errors (loop repeat line do (forward-line -1)) - (point)))) - (when start - (set-window-start w (point)))))) + (let* ((line (if (not line) + (/ (window-height window) 2) + line)) + (start (save-excursion + (loop repeat line do (forward-line -1)) + (point)))) + (set-window-start w start))) (defun sldb-highlight-sexp (&optional start end) "Highlight the first sexp after point." From lgorrie at common-lisp.net Fri Jun 18 19:26:30 2004 From: lgorrie at common-lisp.net (Luke Gorrie) Date: Fri, 18 Jun 2004 12:26:30 -0700 Subject: [slime-cvs] CVS update: slime/ChangeLog Message-ID: Update of /project/slime/cvsroot/slime In directory common-lisp.net:/tmp/cvs-serv26432 Modified Files: ChangeLog Log Message: Date: Fri Jun 18 12:26:30 2004 Author: lgorrie Index: slime/ChangeLog diff -u slime/ChangeLog:1.407 slime/ChangeLog:1.408 --- slime/ChangeLog:1.407 Fri Jun 18 12:26:04 2004 +++ slime/ChangeLog Fri Jun 18 12:26:30 2004 @@ -18,9 +18,9 @@ (slime-list-compiler-notes): Save the window configuration earlier. This fixes an error under XEmacs when dismissing the notes buffer. - (slime-recenter-window): Avoid moving the point. This puts the - keeps the point in the right place when showing debugger-frame - locations in Emacs 21. + (slime-recenter-window): Avoid moving the point. This keeps the + point in the right place when showing debugger-frame locations in + Emacs 21. 2004-06-17 Luke Gorrie From lgorrie at common-lisp.net Fri Jun 18 19:27:37 2004 From: lgorrie at common-lisp.net (Luke Gorrie) Date: Fri, 18 Jun 2004 12:27:37 -0700 Subject: [slime-cvs] CVS update: slime/swank-allegro.lisp Message-ID: Update of /project/slime/cvsroot/slime In directory common-lisp.net:/tmp/cvs-serv28603 Modified Files: swank-allegro.lisp Log Message: >From Matthew Danish: Implemented frame-source-location-for-emacs. Date: Fri Jun 18 12:27:37 2004 Author: lgorrie Index: slime/swank-allegro.lisp diff -u slime/swank-allegro.lisp:1.36 slime/swank-allegro.lisp:1.37 --- slime/swank-allegro.lisp:1.36 Wed Jun 16 15:03:55 2004 +++ slime/swank-allegro.lisp Fri Jun 18 12:27:37 2004 @@ -155,8 +155,10 @@ (disassemble (debugger:frame-function (nth-frame index)))) (defimplementation frame-source-location-for-emacs (index) - (list :error (format nil "Cannot find source for frame: ~A" - (nth-frame index)))) + (let* ((frame (nth-frame index)) + (expr (debugger:frame-expression frame)) + (fspec (first expr))) + (second (first (fspec-definition-locations fspec))))) (defimplementation eval-in-frame (form frame-number) (debugger:eval-form-in-context @@ -242,7 +244,7 @@ ((member :top-level) (list :error (format nil "Defined at toplevel: ~A" fspec))) (null - (list :error (format nil "Unkown source location for ~A" fspec)))))) + (list :error (format nil "Unknown source location for ~A" fspec)))))) (defun fspec-definition-locations (fspec) (let ((defs (excl::find-multiple-definitions fspec))) From lgorrie at common-lisp.net Fri Jun 18 21:54:15 2004 From: lgorrie at common-lisp.net (Luke Gorrie) Date: Fri, 18 Jun 2004 14:54:15 -0700 Subject: [slime-cvs] CVS update: slime/slime.el Message-ID: Update of /project/slime/cvsroot/slime In directory common-lisp.net:/tmp/cvs-serv3537 Modified Files: slime.el Log Message: (slime-buffer-package): If DONT-CACHE is true and no package name can be found, then default to "COMMON-LISP-USER." Previously we just kept using the cached version, but that could lead to error-after-error if it was incorrect. Date: Fri Jun 18 14:54:15 2004 Author: lgorrie Index: slime/slime.el diff -u slime/slime.el:1.320 slime/slime.el:1.321 --- slime/slime.el:1.320 Fri Jun 18 12:26:12 2004 +++ slime/slime.el Fri Jun 18 14:54:15 2004 @@ -758,7 +758,10 @@ (setq slime-buffer-package string) (force-mode-line-update))) string) - (t slime-buffer-package))))) + (t + (if dont-cache + "COMMON-LISP-USER" + slime-buffer-package)))))) (defun slime-find-buffer-package () "Figure out which Lisp package the current buffer is associated with." From lgorrie at common-lisp.net Fri Jun 18 21:54:34 2004 From: lgorrie at common-lisp.net (Luke Gorrie) Date: Fri, 18 Jun 2004 14:54:34 -0700 Subject: [slime-cvs] CVS update: slime/ChangeLog Message-ID: Update of /project/slime/cvsroot/slime In directory common-lisp.net:/tmp/cvs-serv3892 Modified Files: ChangeLog Log Message: Date: Fri Jun 18 14:54:34 2004 Author: lgorrie Index: slime/ChangeLog diff -u slime/ChangeLog:1.408 slime/ChangeLog:1.409 --- slime/ChangeLog:1.408 Fri Jun 18 12:26:30 2004 +++ slime/ChangeLog Fri Jun 18 14:54:34 2004 @@ -1,3 +1,14 @@ +2004-06-18 Luke Gorrie + + * slime.el (slime-buffer-package): If DONT-CACHE is true and no + package name can be found, then default to "COMMON-LISP-USER." + Previously we just kept using the cached version, but that could + lead to error-after-error if it was incorrect. + + * swank.lisp (throw-to-toplevel): If our top-level catcher isn't + on the stack (i.e. we're using the debugger from outside an RPC) + then ABORT instead. That makes 'q' DWIM in SLDB. + 2004-06-18 Matthew Danish * swank-allegro.lisp (frame-source-location-for-emacs): From swksud at gsel.com Fri Jun 18 23:38:03 2004 From: swksud at gsel.com (Collin Perez) Date: Sat, 19 Jun 2004 02:38:03 +0300 Subject: [slime-cvs] Fwd: Order pills online with no prescription shipped to you discreetly overnight Message-ID: <%RNDUCCHAR2025@hkid.com> An HTML attachment was scrubbed... URL: From myrawapleren at american-email.com Sat Jun 19 06:00:39 2004 From: myrawapleren at american-email.com (Nigel Mccord) Date: Sat, 19 Jun 2004 01:00:39 -0500 Subject: [slime-cvs] j07 - Download UNLIMITED Movies, Music, Games, TV Shows, Software, ID: 9248W843 Message-ID: An HTML attachment was scrubbed... URL: From lgorrie at common-lisp.net Sat Jun 19 21:07:41 2004 From: lgorrie at common-lisp.net (Luke Gorrie) Date: Sat, 19 Jun 2004 14:07:41 -0700 Subject: [slime-cvs] CVS update: slime/swank.lisp Message-ID: Update of /project/slime/cvsroot/slime In directory common-lisp.net:/tmp/cvs-serv1671 Modified Files: swank.lisp Log Message: (known-to-emacs-p): Bugfix. Indentation-updates was broken. Date: Sat Jun 19 14:07:41 2004 Author: lgorrie Index: slime/swank.lisp diff -u slime/swank.lisp:1.192 slime/swank.lisp:1.193 --- slime/swank.lisp:1.192 Wed Jun 16 15:04:09 2004 +++ slime/swank.lisp Sat Jun 19 14:07:41 2004 @@ -1709,8 +1709,8 @@ "Return true if Emacs has special rules for indenting SYMBOL." (or (cl-symbol-p symbol) (let ((name (symbol-name symbol))) - (not (or (prefix-match-p "DEF" name) - (prefix-match-p "WITH-" name)))))) + (or (prefix-match-p "DEF" name) + (prefix-match-p "WITH-" name))))) (defun symbol-indentation (symbol) "Return a form describing the indentation of SYMBOL. From bleorraent at pekklemail.com Sat Jun 19 23:48:22 2004 From: bleorraent at pekklemail.com (gil matusik) Date: Sat, 19 Jun 2004 14:48:22 -0900 Subject: [slime-cvs] Uwd l.ow cost for you Message-ID: <5CE81D59.E31A662@pekklemail.com> advertisings ardin caddoan ffecc Enjoy deep discount meds here. You can now order V-i`c`odin, V_a|ium, X.a.nax securely and discreetly. Safe & Secure 0rdering! B http://pk.info.rumsales.com/abc/bbb1/ If you wish for email elim-ination, you can do so here: http://rb.info.rumsales.com/abc/bbb1/rf.html A man was travelling abroad in a small red car. One day he left the car and went shopping. When he came back, its roof was badly damaged. Some boys told him that an elephant had damaged it. The man did not believe them, but they took him to a circus which was near there. The owner of the elephant said, 'I am very sorry! My elephant has a big, round, red chair. He thought that your car was his chair,and he sat on it!' Then he gave the man a letter, in which he said that he was sorry and that he would pay for all the damage. When the man got back to his own country, the customs officers would not believe his story. They said, 'You sold your new car while you were abroad and bought this old one!' It was only when the man showed them the letter from the circus man that they believed him. It was time for an elderly gentleman to be put into a nursing home, as his grown children could no longer care for him.After a week, the children went to visit their father at the nursing home. During the visit, the father leaned to the right, and a nurse quickly came over and propped him up with a pillow. A little while later, he leaned to the left, and again a nurse came and propped him up with another pillow. The man's children were amazed at how attentivethe home seemed to be, and questioned their father on how he liked it there. He responded, "I've been treated well, but I've got to tell you....they sure don't want you to fart here. habitante0huelga68ledani`a,castore\o aguardadora. From lgorrie at common-lisp.net Sun Jun 20 01:51:44 2004 From: lgorrie at common-lisp.net (Luke Gorrie) Date: Sat, 19 Jun 2004 18:51:44 -0700 Subject: [slime-cvs] CVS update: slime/slime.el Message-ID: Update of /project/slime/cvsroot/slime In directory common-lisp.net:/tmp/cvs-serv8309 Modified Files: slime.el Log Message: (slime-abort-connection): Renamed from `slime-connection-abort'. The new name is easier to find with completion. Date: Sat Jun 19 18:51:44 2004 Author: lgorrie Index: slime/slime.el diff -u slime/slime.el:1.321 slime/slime.el:1.322 --- slime/slime.el:1.321 Fri Jun 18 14:54:15 2004 +++ slime/slime.el Sat Jun 19 18:51:44 2004 @@ -1191,7 +1191,7 @@ () (unless (active-minibuffer-window) (message "\ -Polling %S.. (Abort with `M-x slime-connection-abort'.)" +Polling %S.. (Abort with `M-x slime-abort-connection'.)" (slime-swank-port-file))) (setq slime-state-name (format "[polling:%S]" (incf attempt))) (force-mode-line-update) @@ -1265,7 +1265,7 @@ (interactive) (mapc #'slime-net-close slime-net-processes)) -(defun slime-connection-abort () +(defun slime-abort-connection () "Abort connection the current connection attempt." (interactive) (if (null slime-connect-retry-timer) From lgorrie at common-lisp.net Sun Jun 20 04:13:05 2004 From: lgorrie at common-lisp.net (Luke Gorrie) Date: Sat, 19 Jun 2004 21:13:05 -0700 Subject: [slime-cvs] CVS update: slime/slime.el Message-ID: Update of /project/slime/cvsroot/slime In directory common-lisp.net:/tmp/cvs-serv7371 Modified Files: slime.el Log Message: * slime.el: Audited to remove namespace slipups. Tracking a really horrible clashing-with-some-user-configuration bug and want to eliminate potential symbol conflicts. (sldb-get-buffer): Renamed from `get-sldb-buffer'. (slime-emacs-20-p): Renamed from `emacs-20-p'. (slime-defun-if-undefined): Renamed from `defun-if-undefined'. (slime-isearch): Small bugfix that could cause M-. to go to the wrong place in CMUCL. Date: Sat Jun 19 21:13:05 2004 Author: lgorrie Index: slime/slime.el diff -u slime/slime.el:1.322 slime/slime.el:1.323 --- slime/slime.el:1.322 Sat Jun 19 18:51:44 2004 +++ slime/slime.el Sat Jun 19 21:13:05 2004 @@ -1658,7 +1658,7 @@ "Clear all pending continuations." (interactive) (setq slime-rex-continuations '()) - (when-let (sldb (get-sldb-buffer)) + (when-let (sldb (sldb-get-buffer)) (kill-buffer sldb))) (defun slime-nyi () @@ -3102,7 +3102,7 @@ (putp 'slime note) (putp 'face (slime-severity-face severity)) (putp 'severity severity) - (unless (emacs-20-p) + (unless (slime-emacs-20-p) (putp 'mouse-face 'highlight)) (putp 'help-echo message) overlay))) @@ -3339,8 +3339,8 @@ pos1 pos2)) ((> len1 len2) pos1) ((> len2 len1) pos2))) - (pos1 pos1) - (pos2 pos2) + (len1 pos1) + (len2 pos2) (t start)))))) (defun slime-isearch-with-function (search-fn string) @@ -4823,7 +4823,7 @@ (defvar sldb-overlays '() "Overlays created in source code buffers to temporarily highlight expressions.") -(defun get-sldb-buffer (&optional create) +(defun sldb-get-buffer (&optional create) (let* ((number (slime-connection-number)) (buffer-name (format "*sldb [connection #%S]*" number))) (funcall (if create #'get-buffer-create #'get-buffer) @@ -4835,7 +4835,7 @@ 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." - (with-current-buffer (get-sldb-buffer t) + (with-current-buffer (sldb-get-buffer t) (unless (equal sldb-level level) (setq buffer-read-only nil) (sldb-mode) @@ -4860,7 +4860,7 @@ (recursive-edit))))) (defun sldb-activate (thread level) - (with-current-buffer (get-sldb-buffer t) + (with-current-buffer (sldb-get-buffer t) (unless (equal sldb-level level) (with-lexical-bindings (thread level) (slime-eval-async `(swank:debugger-info-for-emacs 0 1) nil @@ -4869,7 +4869,7 @@ ;;; XXX thread is ignored (defun sldb-exit (thread level) - (when-let (sldb (get-sldb-buffer)) + (when-let (sldb (sldb-get-buffer)) (with-current-buffer sldb (set-window-configuration sldb-saved-window-configuration) (let ((inhibit-read-only t)) @@ -5685,9 +5685,9 @@ (def-slime-selector-method ?d "the *sldb* buffer for the current connection." - (unless (get-sldb-buffer) + (unless (sldb-get-buffer) (error "No debugger buffer")) - (get-sldb-buffer)) + (sldb-get-buffer)) (def-slime-selector-method ?e "the most recently visited emacs-lisp-mode buffer." @@ -6292,7 +6292,7 @@ (slime-at-top-level-p))) (defun slime-at-top-level-p () - (and (null (get-sldb-buffer)) + (and (null (sldb-get-buffer)) (null slime-rex-continuations))) (defun slime-wait-condition (name predicate timeout) @@ -6307,7 +6307,7 @@ (slime-wait-condition "top-level" #'slime-at-top-level-p timeout)) (defun slime-check-sldb-level (expected) - (let ((sldb-level (when-let (sldb (get-sldb-buffer)) + (let ((sldb-level (when-let (sldb (sldb-get-buffer)) (with-current-buffer sldb sldb-level)))) (slime-check ("SLDB level (%S) is %S" expected sldb-level) @@ -6320,7 +6320,7 @@ (funcall (or test #'equal) expected actual))) (defun sldb-level () - (when-let (sldb (get-sldb-buffer)) + (when-let (sldb (sldb-get-buffer)) (with-current-buffer sldb sldb-level))) @@ -6440,7 +6440,7 @@ (debug-hook-max-depth 0)) (let ((debug-hook (lambda () - (with-current-buffer (get-sldb-buffer) + (with-current-buffer (sldb-get-buffer) (when (> sldb-level debug-hook-max-depth) (setq debug-hook-max-depth sldb-level) (if (= sldb-level depth) @@ -6459,7 +6459,7 @@ (= debug-hook-max-depth depth)))))) (defun slime-sldb-level= (level) - (when-let (sldb (get-sldb-buffer)) + (when-let (sldb (sldb-get-buffer)) (with-current-buffer sldb (equal sldb-level level)))) @@ -6473,7 +6473,7 @@ (slime-check "In eval state." (not (null slime-rex-continuations))) (slime-interrupt) (slime-wait-condition "First interrupt" (lambda () (slime-sldb-level= 1)) 5) - (with-current-buffer (get-sldb-buffer) + (with-current-buffer (sldb-get-buffer) (sldb-quit)) (slime-sync-to-top-level 5) (slime-check-top-level)) @@ -6488,13 +6488,13 @@ (slime-wait-condition "running" #'slime-busy-p 5) (slime-interrupt) (slime-wait-condition "First interrupt" (lambda () (slime-sldb-level= 1)) 5) - (with-current-buffer (get-sldb-buffer) + (with-current-buffer (sldb-get-buffer) (sldb-continue)) (slime-wait-condition "running" (lambda () (and (slime-busy-p) - (not (get-sldb-buffer)))) 5) + (not (sldb-get-buffer)))) 5) (slime-interrupt) (slime-wait-condition "Second interrupt" (lambda () (slime-sldb-level= 1)) 5) - (with-current-buffer (get-sldb-buffer) + (with-current-buffer (sldb-get-buffer) (sldb-quit)) (slime-sync-to-top-level 5) (slime-check-top-level)) @@ -6529,9 +6529,9 @@ (slime-wait-condition "Debugger visible" (lambda () (and (slime-sldb-level= 1) - (get-buffer-window (get-sldb-buffer)))) + (get-buffer-window (sldb-get-buffer)))) 5) - (with-current-buffer (get-sldb-buffer) + (with-current-buffer (sldb-get-buffer) (sldb-quit)) (slime-sync-to-top-level 5)) @@ -6690,11 +6690,11 @@ ) (eval-when (compile eval) - (defmacro defun-if-undefined (name &rest rest) + (defmacro slime-defun-if-undefined (name &rest rest) `(unless (fboundp ',name) (defun ,name , at rest)))) -(defun-if-undefined next-single-char-property-change +(slime-defun-if-undefined next-single-char-property-change (position prop &optional object limit) (let ((limit (typecase limit (null nil) @@ -6713,7 +6713,7 @@ (get-char-property pos prop object))) return pos)))))) -(defun-if-undefined previous-single-char-property-change +(slime-defun-if-undefined previous-single-char-property-change (position prop &optional object limit) (let ((limit (typecase limit (null nil) @@ -6736,14 +6736,14 @@ (get-char-property (1- pos) prop object))) return pos)))))))) -(defun-if-undefined substring-no-properties (string &optional start end) +(slime-defun-if-undefined substring-no-properties (string &optional start end) (let* ((start (or start 0)) (end (or end (length string))) (string (substring string start end))) (set-text-properties start end nil string) string)) -(defun-if-undefined set-window-text-height (window height) +(slime-defun-if-undefined set-window-text-height (window height) (let ((delta (- height (window-text-height window)))) (unless (zerop delta) (let ((window-min-height 1)) @@ -6753,10 +6753,10 @@ (enlarge-window delta)) (enlarge-window delta)))))) -(defun-if-undefined window-text-height (&optional window) +(slime-defun-if-undefined window-text-height (&optional window) (1- (window-height window))) -(defun-if-undefined subst-char-in-string (fromchar tochar string +(slime-defun-if-undefined subst-char-in-string (fromchar tochar string &optional inplace) "Replace FROMCHAR with TOCHAR in STRING each time it occurs. Unless optional argument INPLACE is non-nil, return a new string." @@ -6768,7 +6768,7 @@ (aset newstr i tochar))) newstr)) -(defun-if-undefined count-screen-lines +(slime-defun-if-undefined count-screen-lines (&optional beg end count-final-newline window) (unless beg (setq beg (point-min))) @@ -6788,19 +6788,19 @@ ;; XXX make this xemacs compatible (1+ (vertical-motion (buffer-size) window)))))) -(defun-if-undefined seconds-to-time (seconds) +(slime-defun-if-undefined seconds-to-time (seconds) "Convert SECONDS (a floating point number) to a time value." (list (floor seconds 65536) (floor (mod seconds 65536)) (floor (* (- seconds (ffloor seconds)) 1000000)))) -(defun-if-undefined time-less-p (t1 t2) +(slime-defun-if-undefined time-less-p (t1 t2) "Say whether time value T1 is less than time value T2." (or (< (car t1) (car t2)) (and (= (car t1) (car t2)) (< (nth 1 t1) (nth 1 t2))))) -(defun-if-undefined time-add (t1 t2) +(slime-defun-if-undefined time-add (t1 t2) "Add two time values. One should represent a time difference." (let ((high (car t1)) (low (if (consp (cdr t1)) (nth 1 t1) (cdr t1))) @@ -6827,18 +6827,18 @@ (list high low micro))) -(defun-if-undefined line-beginning-position (&optional n) +(slime-defun-if-undefined line-beginning-position (&optional n) (save-excursion (forward-line n) (point))) -(defun-if-undefined line-end-position (&optional n) +(slime-defun-if-undefined line-end-position (&optional n) (save-excursion (forward-line n) (end-of-line) (point))) -(defun-if-undefined check-parens () +(slime-defun-if-undefined check-parens () "Verify that parentheses in the current buffer are balanced. If they are not, position point at the first syntax error found." (interactive) @@ -6871,8 +6871,8 @@ (error "After quote")) (t (error "Shouldn't happen: parsing state: %S" state)))))) -(defun-if-undefined read-directory-name (prompt &optional dir default-dirname - mustmatch initial) +(slime-defun-if-undefined read-directory-name (prompt &optional dir default-dirname + mustmatch initial) (unless dir (setq dir default-directory)) (unless default-dirname @@ -6897,7 +6897,7 @@ (or (getenv "TMPDIR") (getenv "TMP") (getenv "TEMP") "/tmp")))) "The directory for writing temporary files.")) -(defun emacs-20-p () +(defun slime-emacs-20-p () (and (not (featurep 'xemacs)) (= emacs-major-version 20))) From lgorrie at common-lisp.net Sun Jun 20 05:46:08 2004 From: lgorrie at common-lisp.net (Luke Gorrie) Date: Sat, 19 Jun 2004 22:46:08 -0700 Subject: [slime-cvs] CVS update: slime/slime.el Message-ID: Update of /project/slime/cvsroot/slime In directory common-lisp.net:/tmp/cvs-serv11588 Modified Files: slime.el Log Message: (slime-changelog-date, slime-check-protocol-version): Removed unneeded functions. Date: Sat Jun 19 22:46:08 2004 Author: lgorrie Index: slime/slime.el diff -u slime/slime.el:1.323 slime/slime.el:1.324 --- slime/slime.el:1.323 Sat Jun 19 21:13:05 2004 +++ slime/slime.el Sat Jun 19 22:46:08 2004 @@ -1224,42 +1224,6 @@ (message "Initial handshake..." port) (slime-init-connection process))) -(defun slime-changelog-date () - "Return the datestring of the latest entry in the ChangeLog file. -If the function is compiled (with the file-compiler) return the date -of the newest at compile time. If the function is interpreted read -the ChangeLog file at runtime." - (macrolet ((date () - (let* ((dir (or (and (boundp 'byte-compile-current-file) - byte-compile-current-file - (file-name-directory - (file-truename - byte-compile-current-file))) - slime-path)) - (file (concat dir "ChangeLog")) - (date (with-temp-buffer - (insert-file-contents file nil 0 100) - (goto-char (point-min)) - (symbol-name (read (current-buffer)))))) - `(quote ,date)))) - (date))) - -(defvar slime-changelog-date nil - "Holds the latest datestring from the ChangeLog as seen at loadtime.") -(setq slime-changelog-date (slime-changelog-date)) - -(defun slime-check-protocol-version (lisp-version) - "Signal an error unless LISP-VERSION is equal to `slime-changelog-date'." - (unless (or (and lisp-version (equal lisp-version slime-changelog-date))) - (message "Disconnecting ...") - (slime-disconnect) - (let ((message (format "Protocol mismatch: Lisp: %s ELisp: %s" - lisp-version slime-changelog-date))) - (message "%s" message) - (sleep-for 2) - (ding 2) - (error "%s" message)))) - (defun slime-disconnect () "Disconnect all connections." (interactive) @@ -1703,8 +1667,7 @@ (defun slime-set-connection-info (connection info) "Initialize CONNECTION with INFO received from Lisp." - (destructuring-bind (version pid type name features) info -;;; (slime-check-protocol-version version) + (destructuring-bind (pid type name features) info (setf (slime-pid) pid (slime-lisp-implementation-type) type (slime-lisp-implementation-type-name) name @@ -1936,7 +1899,8 @@ (setq header-line-format banner)) (when animantep (pop-to-buffer (current-buffer)) - (animate-string (format "; SLIME %s" slime-changelog-date) 0 0)) + (animate-string "; SLIME: The Superior Lisp Interaction Mode for Emacs" + 0 0)) (slime-repl-insert-prompt (if (or (not slime-reply-update-banner-p) use-header-p) "" From lgorrie at common-lisp.net Sun Jun 20 05:46:25 2004 From: lgorrie at common-lisp.net (Luke Gorrie) Date: Sat, 19 Jun 2004 22:46:25 -0700 Subject: [slime-cvs] CVS update: slime/swank-backend.lisp Message-ID: Update of /project/slime/cvsroot/slime In directory common-lisp.net:/tmp/cvs-serv11966 Modified Files: swank-backend.lisp Log Message: (add-hook, run-hook): Added an Emacs-like hook mechiansm. The hope is that this will make some sections of the code more self-describing by showing where they hook in. (*new-connection-hook*): Hook run when a new connection is established. Initialized to '(swank-backend:emacs-connected). (*pre-reply-hook*): Hook run before sending a reply to Emacs. Date: Sat Jun 19 22:46:24 2004 Author: lgorrie Index: slime/swank-backend.lisp diff -u slime/swank-backend.lisp:1.53 slime/swank-backend.lisp:1.54 --- slime/swank-backend.lisp:1.53 Wed Jun 16 15:03:58 2004 +++ slime/swank-backend.lisp Sat Jun 19 22:46:24 2004 @@ -25,6 +25,10 @@ #:position-pos #:print-output-to-string #:quit-lisp + #:*new-connection-hook* + #:*pre-reply-hook* + #:add-hook + #:run-hook )) (in-package :swank-backend) @@ -98,7 +102,30 @@ (cons `(,(first name) (,(reader (second name)) ,tmp))) (t (error "Malformed syntax in WITH-STRUCT: ~A" name)))) , at body))))) - + +;;;; Hooks +;;; +;;; We use Emacs-like `add-hook' and `run-hook' utilities to support +;;; simple indirection. The interface is more CLish than the Emacs +;;; Lisp one. + +(defmacro add-hook (place function) + "Add FUNCTION to the list of values on HOOK-VARIABLE." + `(pushnew ,function ,place)) + +(defun run-hook (functions &rest arguments) + "Call each of FUNCTIONS with ARGUMENTS." + (dolist (function functions) + (apply function arguments))) + +(defvar *new-connection-hook* '(emacs-connected) + "This hook is run each time a connection is established. +The connection structure is given as the argument.") + +(defvar *pre-reply-hook* '() + "Hook run (without arguments) immediately before replying to an RPC.") + + ;;;; TCP server (definterface create-socket (host port) From lgorrie at common-lisp.net Sun Jun 20 05:47:32 2004 From: lgorrie at common-lisp.net (Luke Gorrie) Date: Sat, 19 Jun 2004 22:47:32 -0700 Subject: [slime-cvs] CVS update: slime/swank.lisp Message-ID: Update of /project/slime/cvsroot/slime In directory common-lisp.net:/tmp/cvs-serv13383 Modified Files: swank.lisp Log Message: Added some comments and docstrings. (changelog-date): Removed unneeded function. (connection-info): No more version field in result. (package-external-symbols): Removed unused function. (serve-connection): Call *new-connection-hook*. (eval-for-emacs): Call *pre-reply-hook*. (sync-features-to-emacs, sync-indentation-to-emacs): Added to *pre-reply-hook*. (cl-package, keyword-package): Now defconstant instead of defvar. Removed the *'s accordingly. Date: Sat Jun 19 22:47:32 2004 Author: lgorrie Index: slime/swank.lisp diff -u slime/swank.lisp:1.193 slime/swank.lisp:1.194 --- slime/swank.lisp:1.193 Sat Jun 19 14:07:41 2004 +++ slime/swank.lisp Sat Jun 19 22:47:32 2004 @@ -1,11 +1,16 @@ -;;;; -*- Mode: lisp; outline-regexp: ";;;;;*"; indent-tabs-mode: nil -*-;;; +;;; -*- Mode: lisp; outline-regexp: ";;;;;*"; indent-tabs-mode: nil -*-;;; ;;; -;;; swank.lisp --- the portable bits +;;; This code has been placed in the Public Domain. All warranties +;;; are disclaimed. ;;; -;;; Created 2003, Daniel Barlow +;;;; swank.lisp ;;; -;;; This code has been placed in the Public Domain. All warranties are -;;; disclaimed. +;;; This file defines the "Swank" TCP server for Emacs to talk to. The +;;; code in this file is purely portable Common Lisp. We do require a +;;; smattering of non-portable functions in order to write the server, +;;; so we have defined them in `swank-backend.lisp' and implemented +;;; them separately for each Lisp implementation. These extensions are +;;; available to us here via the `SWANK-BACKEND' package. (defpackage :swank (:use :common-lisp :swank-backend) @@ -16,14 +21,14 @@ #:ed-in-emacs #:print-indentation-lossage #:swank-debugger-hook - ;; configurables + ;; These are user-configurable variables: #:*sldb-pprint-frames* #:*communication-style* #:*log-events* #:*use-dedicated-output-stream* #:*configure-emacs-indentation* #:*readtable-alist* - ;; re-exported from backend + ;; These are re-exported directly from the backend: #:frame-source-location-for-emacs #:restart-frame #:sldb-step @@ -39,16 +44,21 @@ (in-package #:swank) -(defvar *cl-package* (find-package :cl)) -(defvar *keyword-package* (find-package :keyword)) +;;;; Top-level variables, constants, macros + +(defconstant cl-package (find-package :cl) + "The COMMON-LISP package.") + +(defconstant keyword-package (find-package :keyword) + "The KEYWORD package.") (defvar *swank-io-package* (let ((package (make-package :swank-io-package :use '()))) (import '(nil t quote) package) package)) -(defconstant +server-port+ 4005 - "Default port for the Swank TCP server.") +(defconstant default-server-port 4005 + "The default TCP port for the server (when started manually).") (defvar *swank-debug-p* t "When true, print extra debugging information.") @@ -56,10 +66,11 @@ (defvar *sldb-pprint-frames* nil "*pretty-print* is bound to this value when sldb prints a frame.") -;;; public interface. slimefuns are the things that emacs is allowed -;;; to call +;;; The `DEFSLIMEFUN' macro defines a function that Emacs can call via +;;; RPC. (defmacro defslimefun (name arglist &body rest) + "A DEFUN for functions that Emacs can call by RPC." `(progn (defun ,name ,arglist , at rest) ;; see @@ -68,15 +79,12 @@ (declaim (ftype (function () nil) missing-arg)) (defun missing-arg () + "A function that the compiler knows will never to return a value. +You can use (MISSING-ARG) as the initform for defstruct slots that +must always be supplied. This way the :TYPE slot option need not +include some arbitrary initial value like NIL." (error "A required &KEY or &OPTIONAL argument was not supplied.")) -(defun package-external-symbols (package) - (let ((list '())) - (do-external-symbols (sym package) (push sym list)) - list)) - -;; (package-external-symbols (find-package :swank)) - ;;;; Connections ;;; @@ -87,9 +95,7 @@ ;;; (defstruct (connection - (:conc-name connection.) - ;; (:print-function %print-connection) - ) + (:conc-name connection.)) ;; Raw I/O stream of socket connection. (socket-io (missing-arg) :type stream :read-only t) ;; Optional dedicated output socket (backending `user-output' slot). @@ -100,36 +106,40 @@ (user-input nil :type (or stream null)) (user-output nil :type (or stream null)) (user-io nil :type (or stream null)) - ;; - control-thread + ;; In multithreaded systems we delegate certain tasks to specific + ;; threads. The `reader-thread' is responsible for reading network + ;; requests from Emacs and sending them to the `control-thread'; the + ;; `control-thread' is responsible for dispatching requests to the + ;; threads that should handle them; the `repl-thread' is the one + ;; that evaluates REPL expressions. The control thread dispatches + ;; all REPL evaluations to the REPL thread and for other requests it + ;; spawns new threads. reader-thread - ;; The REPL thread loops receiving functions to apply. - ;; REPL expressions are sent to this thread for evaluation so that - ;; they always run in the same thread. + control-thread repl-thread + ;; Callback functions: + ;; (SERVE-REQUESTS ) serves all pending requests + ;; from Emacs. + (serve-requests (missing-arg) :type function) + ;; (READ) is called to read and return one message from Emacs. (read (missing-arg) :type function) + ;; (SEND OBJECT) is called to send one message to Emacs. (send (missing-arg) :type function) - (serve-requests (missing-arg) :type function) + ;; (CLEANUP ) is called when the connection is + ;; closed. (cleanup nil :type (or null function)) - ;; Cache of indentation information that has been sent to Emacs. - ;; This is used for preparing deltas for updates. - ;; Maps: symbol -> indentation specification + ;; Cache of macro-indentation information that has been sent to Emacs. + ;; This is used for preparing deltas to update Emacs's knowledge. + ;; Maps: symbol -> indentation-specification (indentation-cache (make-hash-table :test 'eq) :type hash-table) - ;; The list of packages represented in the cache. - (indentation-cache-packages nil) - ) - -#+(or) -(defun %print-connection (connection stream depth) - (declare (ignore depth)) - (print-unreadable-object (connection stream :type t :identity t))) + ;; The list of packages represented in the cache: + (indentation-cache-packages '())) (defvar *connections* '() "List of all active connections, with the most recent at the front.") (defvar *emacs-connection* nil - "The connection to Emacs. -All threads communicate through this interface with Emacs.") + "The connection to Emacs currently in use.") (defvar *swank-state-stack* '() "A list of symbols describing the current state. Used for debugging @@ -137,9 +147,12 @@ (defun default-connection () "Return the 'default' Emacs connection. +This connection can be used to talk with Emacs when no specific +connection is in use, i.e. *EMACS-CONNECTION* is NIL. + The default connection is defined (quite arbitrarily) as the most recently established one." - (car *connections*)) + (first *connections*)) (defslimefun state-stack () "Return the value of *SWANK-STATE-STACK*." @@ -154,8 +167,8 @@ ;;;; Helper macros (defmacro with-io-redirection ((connection) &body body) - "Execute BODY with I/O redirection to CONNECTION. -If *REDIRECT-IO* is true, all standard I/O streams are redirected." + "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))) @@ -220,13 +233,13 @@ (setup-server 0 (lambda (port) (announce-server-port port-file port)) style dont-close)) -(defun create-server (&key (port +server-port+) +(defun create-server (&key (port default-server-port) (style *communication-style*) dont-close) "Start a SWANK server on PORT." (setup-server port #'simple-announce-function style dont-close)) -(defun create-swank-server (&optional (port +server-port+) +(defun create-swank-server (&optional (port default-server-port) (style *communication-style*) (announce-fn #'simple-announce-function) dont-close) @@ -261,7 +274,7 @@ (unless dont-close (close-socket socket)) (let ((connection (create-connection client style))) - (init-emacs-connection connection) + (run-hook *new-connection-hook* connection) (push connection *connections*) (serve-requests connection)))) @@ -269,9 +282,6 @@ "Read and process all requests on connections." (funcall (connection.serve-requests connection) connection)) -(defun init-emacs-connection (connection) - (emacs-connected (connection.user-io connection))) - (defun announce-server-port (file port) (with-open-file (s file :direction :output @@ -337,21 +347,6 @@ (with-simple-restart (abort "Abort handling SLIME request.") (read-from-emacs))))) -(defun changelog-date () - "Return the datestring of the latest ChangeLog entry. The date is -determined at compile time." - (macrolet ((date () - (let* ((here (or *compile-file-truename* *load-truename*)) - (changelog (make-pathname - :name "ChangeLog" - :device (pathname-device here) - :directory (pathname-directory here) - :host (pathname-host here))) - (date (with-open-file (file changelog :direction :input) - (string (read file))))) - `(quote ,date)))) - (date))) - (defun current-socket-io () (connection.socket-io *emacs-connection*)) @@ -682,13 +677,6 @@ (defvar *slime-features* nil "The feature list that has been sent to Emacs.") -(defun sync-state-to-emacs () - "Update Emacs if any relevant Lisp state has changed." - (unless (eq *slime-features* *features*) - (setq *slime-features* *features*) - (send-to-emacs (list :new-features (mapcar #'symbol-name *features*)))) - (update-connection-indentation *emacs-connection*)) - (defun send-to-emacs (object) "Send OBJECT to Emacs." (funcall (connection.send *emacs-connection*) object)) @@ -749,8 +737,7 @@ (defslimefun connection-info () "Return a list of the form: \(VERSION PID IMPLEMENTATION-TYPE IMPLEMENTATION-NAME FEATURES)." - (list (changelog-date) - (getpid) + (list (getpid) (lisp-implementation-type) (lisp-implementation-type-name) (setq *slime-features* *features*))) @@ -788,7 +775,7 @@ (defun parse-symbol (string) "Find the symbol named STRING. Return the symbol and a flag indicate if the symbols was found." - (multiple-value-bind (sym pos) (let ((*package* *keyword-package*)) + (multiple-value-bind (sym pos) (let ((*package* keyword-package)) (ignore-errors (read-from-string string))) (if (and (symbolp sym) (eql (length string) pos)) (find-symbol (string sym)) @@ -800,7 +787,7 @@ (multiple-value-bind (sym pos) (if (zerop (length string)) (values :|| 0) - (let ((*package* *keyword-package*)) + (let ((*package* keyword-package)) (ignore-errors (read-from-string string)))) (if (and (keywordp sym) (= (length string) pos)) (find-package sym)))) @@ -1084,7 +1071,12 @@ (continue)) (defslimefun throw-to-toplevel () - (throw 'slime-toplevel nil)) + "Use THROW to abort an RPC from Emacs. +If we are not evaluating an RPC then ABORT instead." + (ignore-errors (throw 'slime-toplevel nil)) + ;; If we get here then there was no catch. Try aborting as a fallback. + ;; That makes the 'q' command in SLDB safer to use with threads. + (abort)) (defslimefun invoke-nth-restart-for-emacs (sldb-level n) "Invoke the Nth available restart. @@ -1158,7 +1150,7 @@ (assert (readtablep *buffer-readtable*)) (setq result (eval form)) (force-output) - (sync-state-to-emacs) + (run-hook *pre-reply-hook*) (setq ok t)) (force-user-output) (send-to-emacs `(:return ,(current-thread) @@ -1640,129 +1632,6 @@ (assert (equal '("foo") (names "FO"))))) -;;;; Indentation -;;; -;;; This code decides how macros should be indented (based on their -;;; arglists) and tells Emacs. A per-connection cache is used to avoid -;;; sending redundant information to Emacs -- we just say what's -;;; changed since last time. -;;; -;;; The strategy is to scan all symbols, pick out the macros, and look -;;; for &body-arguments. - -(defvar *configure-emacs-indentation* t - "When true, automatically send indentation information to Emacs -after each command.") - -(defslimefun update-indentation-information () - (perform-indentation-update *emacs-connection* t)) - -;; Called automatically at the end of each request. -(defun update-connection-indentation (connection) - "Send any indentation updates to Emacs via CONNECTION." - (when *configure-emacs-indentation* - (perform-indentation-update connection - (need-full-indentation-update-p connection)))) - -(defun perform-indentation-update (connection force) - (let* ((cache (connection.indentation-cache connection)) - (delta (update-indentation/delta-for-emacs cache force))) - (when force - (setf (connection.indentation-cache-packages connection) - (list-all-packages))) - (when delta - (send-to-emacs (list :indentation-update delta))))) - -(defun need-full-indentation-update-p (connection) - "Return true if the whole indentation cache should be updated. -This is a heuristic to avoid scanning all symbols all the time: -instead, we only do a full scan if the set of packages has changed." - (set-difference (list-all-packages) - (connection.indentation-cache-packages connection))) - -(defun update-indentation/delta-for-emacs (cache &optional force) - "Update the cache and return the changes in a (SYMBOL . INDENT) list. -If FORCE is true then check all symbols, otherwise only check symbols -belonging to the buffer package." - (let ((alist '())) - (flet ((consider (symbol) - (let ((indent (symbol-indentation symbol))) - (when indent - (unless (equal (gethash symbol cache) indent) - (setf (gethash symbol cache) indent) - (push (cons (string-downcase (symbol-name symbol)) - indent) - alist)))))) - (if force - (do-all-symbols (symbol) - (consider symbol)) - (do-symbols (symbol *buffer-package*) - (when (eq (symbol-package symbol) *buffer-package*) - (consider symbol))))) - alist)) - -(defun cl-symbol-p (symbol) - "Is SYMBOL a symbol in the COMMON-LISP package?" - (eq (symbol-package symbol) *cl-package*)) - -(defun known-to-emacs-p (symbol) - "Return true if Emacs has special rules for indenting SYMBOL." - (or (cl-symbol-p symbol) - (let ((name (symbol-name symbol))) - (or (prefix-match-p "DEF" name) - (prefix-match-p "WITH-" name))))) - -(defun symbol-indentation (symbol) - "Return a form describing the indentation of SYMBOL. -The form is to be used as the `common-lisp-indent-function' property -in Emacs." - (if (and (macro-function symbol) - (not (known-to-emacs-p symbol))) - (let ((arglist (arglist symbol))) - (etypecase arglist - ((member :not-available) - nil) - (list - (macro-indentation arglist)))) - nil)) - -(defun macro-indentation (arglist) - (if (well-formed-list-p arglist) - (position '&body (remove '&whole arglist)) - nil)) - -(defun well-formed-list-p (list) - "Is LIST a proper list terminated by NIL?" - (typecase list - (null t) - (cons (well-formed-list-p (cdr list))) - (t nil))) - -(defun print-indentation-lossage (&optional (stream *standard-output*)) - "Return the list of symbols whose indentation styles collide incompatibly. -Collisions are caused because package information is ignored." - (let ((table (make-hash-table :test 'equal))) - (flet ((name (s) (string-downcase (symbol-name s)))) - (do-all-symbols (s) - (setf (gethash (name s) table) - (cons s (symbol-indentation s)))) - (let ((collisions '())) - (do-all-symbols (s) - (let* ((entry (gethash (name s) table)) - (owner (car entry)) - (indent (cdr entry))) - (unless (or (eq s owner) - (equal (symbol-indentation s) indent) - (and (not (fboundp s)) - (null (macro-function s)))) - (pushnew owner collisions) - (pushnew s collisions)))) - (if (null collisions) - (format stream "~&No worries!~%") - (format stream "~&Symbols with collisions:~%~{ ~S~%~}" - collisions)))))) - - ;;;; Documentation (defslimefun apropos-list-for-emacs (name &optional external-only @@ -2211,6 +2080,148 @@ (defslimefun kill-thread-by-id (id) (kill-thread (lookup-thread-by-id id))) + + +;;;; Automatically synchronized state +;;; +;;; Here we add hooks to push updates of relevant information to +;;; Emacs. + +;;;;; *FEATURES* + +(defun sync-features-to-emacs () + "Update Emacs if any relevant Lisp state has changed." + ;; FIXME: *slime-features* should be connection-local + (unless (eq *slime-features* *features*) + (setq *slime-features* *features*) + (send-to-emacs (list :new-features (mapcar #'symbol-name *features*))))) + +(add-hook *pre-reply-hook* 'sync-features-to-emacs) + + +;;;;; Indentation of macros +;;; +;;; This code decides how macros should be indented (based on their +;;; arglists) and tells Emacs. A per-connection cache is used to avoid +;;; sending redundant information to Emacs -- we just say what's +;;; changed since last time. +;;; +;;; The strategy is to scan all symbols, pick out the macros, and look +;;; for &body-arguments. + +(defvar *configure-emacs-indentation* t + "When true, automatically send indentation information to Emacs +after each command.") + +(defslimefun update-indentation-information () + (perform-indentation-update *emacs-connection* t)) + +;; This function is for *PRE-REPLY-HOOK*. +(defun sync-indentation-to-emacs () + "Send any indentation updates to Emacs via CONNECTION." + (when *configure-emacs-indentation* + (let ((fullp (need-full-indentation-update-p *emacs-connection*))) + (perform-indentation-update *emacs-connection* fullp)))) + +(defun perform-indentation-update (connection force) + (let* ((cache (connection.indentation-cache connection)) + (delta (update-indentation/delta-for-emacs cache force))) + (when force + (setf (connection.indentation-cache-packages connection) + (list-all-packages))) + (when delta + (send-to-emacs (list :indentation-update delta))))) + +(defun need-full-indentation-update-p (connection) + "Return true if the whole indentation cache should be updated. +This is a heuristic to avoid scanning all symbols all the time: +instead, we only do a full scan if the set of packages has changed." + (set-difference (list-all-packages) + (connection.indentation-cache-packages connection))) + +(defun update-indentation/delta-for-emacs (cache &optional force) + "Update the cache and return the changes in a (SYMBOL . INDENT) list. +If FORCE is true then check all symbols, otherwise only check symbols +belonging to the buffer package." + (let ((alist '())) + (flet ((consider (symbol) + (let ((indent (symbol-indentation symbol))) + (when indent + (unless (equal (gethash symbol cache) indent) + (setf (gethash symbol cache) indent) + (push (cons (string-downcase (symbol-name symbol)) + indent) + alist)))))) + (if force + (do-all-symbols (symbol) + (consider symbol)) + (do-symbols (symbol *buffer-package*) + (when (eq (symbol-package symbol) *buffer-package*) + (consider symbol))))) + alist)) + +(defun cl-symbol-p (symbol) + "Is SYMBOL a symbol in the COMMON-LISP package?" + (eq (symbol-package symbol) cl-package)) + +(defun known-to-emacs-p (symbol) + "Return true if Emacs has special rules for indenting SYMBOL." + (or (cl-symbol-p symbol) + (let ((name (symbol-name symbol))) + (or (prefix-match-p "DEF" name) + (prefix-match-p "WITH-" name))))) + +(defun symbol-indentation (symbol) + "Return a form describing the indentation of SYMBOL. +The form is to be used as the `common-lisp-indent-function' property +in Emacs." + (if (and (macro-function symbol) + (not (known-to-emacs-p symbol))) + (let ((arglist (arglist symbol))) + (etypecase arglist + ((member :not-available) + nil) + (list + (macro-indentation arglist)))) + nil)) + +(defun macro-indentation (arglist) + (if (well-formed-list-p arglist) + (position '&body (remove '&whole arglist)) + nil)) + +(defun well-formed-list-p (list) + "Is LIST a proper list terminated by NIL?" + (typecase list + (null t) + (cons (well-formed-list-p (cdr list))) + (t nil))) + +(defun print-indentation-lossage (&optional (stream *standard-output*)) + "Return the list of symbols whose indentation styles collide incompatibly. +Collisions are caused because package information is ignored." + (let ((table (make-hash-table :test 'equal))) + (flet ((name (s) (string-downcase (symbol-name s)))) + (do-all-symbols (s) + (setf (gethash (name s) table) + (cons s (symbol-indentation s)))) + (let ((collisions '())) + (do-all-symbols (s) + (let* ((entry (gethash (name s) table)) + (owner (car entry)) + (indent (cdr entry))) + (unless (or (eq s owner) + (equal (symbol-indentation s) indent) + (and (not (fboundp s)) + (null (macro-function s)))) + (pushnew owner collisions) + (pushnew s collisions)))) + (if (null collisions) + (format stream "~&No worries!~%") + (format stream "~&Symbols with collisions:~%~{ ~S~%~}" + collisions)))))) + +(add-hook *pre-reply-hook* 'sync-indentation-to-emacs) ;;; Local Variables: ;;; eval: (font-lock-add-keywords 'lisp-mode '(("(\\(defslimefun\\)\\s +\\(\\(\\w\\|\\s_\\)+\\)" (1 font-lock-keyword-face) (2 font-lock-function-name-face)))) From lgorrie at common-lisp.net Sun Jun 20 05:48:06 2004 From: lgorrie at common-lisp.net (Luke Gorrie) Date: Sat, 19 Jun 2004 22:48:06 -0700 Subject: [slime-cvs] CVS update: slime/ChangeLog Message-ID: Update of /project/slime/cvsroot/slime In directory common-lisp.net:/tmp/cvs-serv14239 Modified Files: ChangeLog Log Message: Date: Sat Jun 19 22:48:06 2004 Author: lgorrie Index: slime/ChangeLog diff -u slime/ChangeLog:1.409 slime/ChangeLog:1.410 --- slime/ChangeLog:1.409 Fri Jun 18 14:54:34 2004 +++ slime/ChangeLog Sat Jun 19 22:48:06 2004 @@ -1,3 +1,46 @@ +2004-06-20 Luke Gorrie + + * swank.lisp (changelog-date): Removed unneeded function. + (connection-info): No more version field in result. + + * slime.el: Audited to remove namespace slipups. Tracking a really + horrible clashing-with-some-user-configuration bug and want to + eliminate potential symbol conflicts. + (sldb-get-buffer): Renamed from `get-sldb-buffer'. + (slime-emacs-20-p): Renamed from `emacs-20-p'. + (slime-defun-if-undefined): Renamed from `defun-if-undefined'. + (slime-isearch): Small bugfix that could cause M-. to go to the + wrong place in CMUCL. + (slime-changelog-date, slime-check-protocol-version): Removed + unneeded functions. + + * swank-backend.lisp (add-hook, run-hook): Added an Emacs-like + hook mechiansm. The hope is that this will make some sections of + the code more self-describing by showing where they hook in. + (*new-connection-hook*): Hook run when a new connection is + established. Initialized to '(swank-backend:emacs-connected). + (*pre-reply-hook*): Hook run before sending a reply to Emacs. + + * swank.lisp: Added some comments and docstrings. + (package-external-symbols): Removed unused function. + (serve-connection): Call *new-connection-hook*. + (eval-for-emacs): Call *pre-reply-hook*. + (sync-features-to-emacs, sync-indentation-to-emacs): Added to + *pre-reply-hook*. + (cl-package, keyword-package): Now defconstant instead of + defvar. Removed the *'s accordingly. + + * slime.el (slime-abort-connection): Renamed from + `slime-connection-abort'. The new name is easier to find with + completion. + + * swank-sbcl.lisp: Change sb-posix:: to sb-posix: + +2004-06-19 Luke Gorrie + + * swank.lisp (known-to-emacs-p): Bugfix. Indentation-updates was + broken. + 2004-06-18 Luke Gorrie * slime.el (slime-buffer-package): If DONT-CACHE is true and no From lgorrie at common-lisp.net Sun Jun 20 05:49:08 2004 From: lgorrie at common-lisp.net (Luke Gorrie) Date: Sat, 19 Jun 2004 22:49:08 -0700 Subject: [slime-cvs] CVS update: slime/ChangeLog Message-ID: Update of /project/slime/cvsroot/slime In directory common-lisp.net:/tmp/cvs-serv17006 Modified Files: ChangeLog Log Message: *** empty log message *** Date: Sat Jun 19 22:49:08 2004 Author: lgorrie Index: slime/ChangeLog diff -u slime/ChangeLog:1.410 slime/ChangeLog:1.411 --- slime/ChangeLog:1.410 Sat Jun 19 22:48:06 2004 +++ slime/ChangeLog Sat Jun 19 22:49:08 2004 @@ -15,7 +15,7 @@ unneeded functions. * swank-backend.lisp (add-hook, run-hook): Added an Emacs-like - hook mechiansm. The hope is that this will make some sections of + hook mechanism. The hope is that this will make some sections of the code more self-describing by showing where they hook in. (*new-connection-hook*): Hook run when a new connection is established. Initialized to '(swank-backend:emacs-connected). From zefpqhdadr at msn.com Sun Jun 20 11:08:43 2004 From: zefpqhdadr at msn.com (Jonathan Forbes) Date: Sun, 20 Jun 2004 06:08:43 -0500 Subject: [slime-cvs] Get Viagra Online Cheap! Internet Special! Message-ID: An HTML attachment was scrubbed... URL: From heller at common-lisp.net Sun Jun 20 13:39:40 2004 From: heller at common-lisp.net (Helmut Eller) Date: Sun, 20 Jun 2004 06:39:40 -0700 Subject: [slime-cvs] CVS update: slime/slime.el Message-ID: Update of /project/slime/cvsroot/slime In directory common-lisp.net:/tmp/cvs-serv18376 Modified Files: slime.el Log Message: Fix outline structure. Date: Sun Jun 20 06:39:40 2004 Author: heller Index: slime/slime.el diff -u slime/slime.el:1.324 slime/slime.el:1.325 --- slime/slime.el:1.324 Sat Jun 19 22:46:08 2004 +++ slime/slime.el Sun Jun 20 06:39:39 2004 @@ -1629,7 +1629,7 @@ (error "Not yet implemented!")) -;;;; Connection initialization +;;;;; Connection initialization (defun slime-init-connection (proc) "Initialize the stack machine." @@ -1701,14 +1701,14 @@ slime-repl-read-mode)) +;;;;;;; Event logging to *slime-events* + (defvar slime-log-events t "*Log protocol events to the *slime-events* buffer.") (defvar slime-inhibit-outline-mode-in-events-buffer t "*Don't use outline-mode if true.") -;;;;;;; Event logging to *slime-events* - (defun slime-pprint-event (object buffer) "Pretty print OBJECT in BUFFER with limited depth and width." (let ((print-length 20) @@ -2286,9 +2286,11 @@ (current-prefix-arg (slime-repl-send-input)) (slime-repl-read-mode ; bad style? + (insert "\n") (slime-repl-send-input)) ((slime-input-complete-p slime-repl-input-start-mark slime-repl-input-end-mark) + (insert "\n") (slime-repl-send-input)) (t (slime-repl-newline-and-indent) @@ -2300,7 +2302,6 @@ (error "No input at point.")) (let ((input (slime-repl-current-input))) (goto-char slime-repl-input-end-mark) - (insert "\n") (add-text-properties slime-repl-input-start-mark (point) '(face slime-repl-input-face rear-nonsticky (face) @@ -2394,34 +2395,6 @@ (insert unfinished-input))))) -;;; Scratch - -(defvar slime-scratch-mode-map) -(setq slime-scratch-mode-map (make-sparse-keymap)) -(set-keymap-parent slime-scratch-mode-map lisp-mode-map) - -(defun slime-scratch-buffer () - "Return the scratch buffer, create it if necessary." - (or (get-buffer "*slime-scratch*") - (with-current-buffer (get-buffer-create "*slime-scratch*") - (lisp-mode) - (use-local-map slime-scratch-mode-map) - (slime-mode t) - (current-buffer)))) - -(defun slime-switch-to-scratch-buffer () - (set-buffer (slime-scratch-buffer)) - (unless (eq (current-buffer) (window-buffer)) - (pop-to-buffer (current-buffer) t))) - -(defun slime-scratch () - (interactive) - (slime-switch-to-scratch-buffer)) - -(slime-define-keys slime-scratch-mode-map - ("\C-j" 'slime-eval-print-last-expression)) - - ;;;;; History (defvar slime-repl-history-pattern nil @@ -2558,6 +2531,236 @@ (message "Read aborted"))) +;;;;; REPL handlers + +(defstruct (slime-repl-shortcut (:conc-name slime-repl-shortcut.)) + symbol names handler one-liner) + +(defvar slime-repl-shortcut-table nil + "A list of slime-repl-shortcuts") + +(defvar slime-repl-shortcut-history '() + "History list of shortcut command names.") + +(defun slime-handle-repl-shortcut () + (interactive) + (if (save-excursion + (goto-char slime-repl-input-start-mark) + (looking-at " *$")) + (let ((shortcut (slime-lookup-shortcut + (completing-read "Command: " + (slime-bogus-completion-alist + (slime-list-all-repl-shortcuts)) + nil t nil + 'slime-repl-shortcut-history)))) + (call-interactively (slime-repl-shortcut.handler shortcut))) + (insert (string slime-repl-shortcut-dispatch-char)))) + +(defun slime-list-all-repl-shortcuts () + (loop for shortcut in slime-repl-shortcut-table + append (slime-repl-shortcut.names shortcut))) + +(defun slime-lookup-shortcut (name) + (find-if (lambda (s) (member name (slime-repl-shortcut.names s))) + slime-repl-shortcut-table)) + +(defmacro defslime-repl-shortcut (elisp-name names &rest options) + "Define a new repl shortcut. ELISP-NAME is a symbol specifying + the name of the interactive function to create, or NIL if no + function should be created. NAMES is a list of (full-name . + aliases). OPTIONS is an olist specifying the handler and the + help text." + `(progn + ,(when elisp-name + `(defun ,elisp-name () + (interactive) + (call-interactively ,(second (assoc :handler options))))) + (let ((new-shortcut (make-slime-repl-shortcut + :symbol ',elisp-name + :names (list , at names) + ,@(apply #'append options)))) + (setq slime-repl-shortcut-table + (remove-if (lambda (s) + (member ',(car names) (slime-repl-shortcut.names s))) + slime-repl-shortcut-table)) + (push new-shortcut slime-repl-shortcut-table) + ',elisp-name))) + +(defun slime-list-repl-short-cuts () + (interactive) + (slime-with-output-to-temp-buffer "*slime-repl-help*" nil + (let ((table (sort* slime-repl-shortcut-table #'string< + :key (lambda (x) + (car (slime-repl-shortcut.names x)))))) + (dolist (shortcut table) + (let ((names (slime-repl-shortcut.names shortcut))) + (insert (pop names)) ;; first print the "full" name + (when names + ;; we also have aliases + (insert " (aka ") + (while (cdr names) + (insert (pop names) ", ")) + (insert (car names) ")")) + (insert "\n " (slime-repl-shortcut.one-liner shortcut) + "\n")))))) + +(defslime-repl-shortcut slime-repl-shortcut-help ("help" "?") + (:handler 'slime-list-repl-short-cuts) + (:one-liner "Display the help.")) + +(defslime-repl-shortcut nil ("change-directory" "!d" "cd") + (:handler 'slime-set-default-directory) + (:one-liner "Change the current directory.")) + +(defslime-repl-shortcut nil ("pwd") + (:handler (lambda () + (interactive) + (let ((dir (slime-eval `(swank:default-directory)))) + (message "Directory %s" dir)))) + (:one-liner "Change the current directory.")) + +(defslime-repl-shortcut slime-repl-push-directory ("push-directory" "+d" + "pushd") + (:handler (lambda (directory) + (interactive + (list (read-directory-name + "Push directory: " + (slime-eval '(swank:default-directory)) nil nil "")) + (push directory slime-repl-directory-stack) + (slime-set-default-directory directory)))) + (:one-liner "Push a new directory onto the directory stack.")) + +(defslime-repl-shortcut slime-repl-pop-directory ("pop-directory" "-d") + (:handler (lambda () + (interactive) + (unless (= 1 (length slime-repl-directory-stack)) + (pop slime-repl-directory-stack)) + (slime-set-default-directory (car slime-repl-directory-stack)))) + (:one-liner "Pop the current directory.")) + +(defslime-repl-shortcut nil ("change-package" "!p") + (:handler 'slime-repl-set-package) + (:one-liner "Change the current package.")) + +(defslime-repl-shortcut slime-repl-push-package ("push-package" "+p") + (:handler (lambda (package) + (interactive (list (slime-read-package-name "Package: "))) + (push package slime-repl-package-stack) + (slime-repl-set-package package))) + (:one-liner "Push a package onto the package stack.")) + +(defslime-repl-shortcut slime-repl-pop-package ("pop-package" "-p") + (:handler (lambda () + (interactive) + (unless (= 1 (length slime-repl-package-stack)) + (pop slime-repl-package-stack)) + (slime-repl-set-package (car slime-repl-package-stack)))) + (:one-liner "Pop the top of the package stack.")) + +(defslime-repl-shortcut slime-repl-resend ("resend-form") + (:handler (lambda () + (interactive) + (insert (car slime-repl-input-history)) + (insert "\n") + (slime-repl-send-input))) + (:one-liner "Resend the last form.")) + +(defslime-repl-shortcut slime-repl-sayoonara ("sayoonara" "quit") + (:handler (lambda () + (interactive) + (when (slime-connected-p) + (slime-eval-async '(swank:quit-lisp) nil (lambda (_) nil))) + (slime-kill-all-buffers))) + (:one-liner "Quit the lisp and close all SLIME buffers.")) + +(defslime-repl-shortcut slime-repl-defparameter ("defparameter" "!") + (:handler (lambda (name value) + (interactive (list (slime-read-symbol-name "Name (symbol): " t) + (slime-read-from-minibuffer "Value: " "nil"))) + (insert "(cl:defparameter " name " " value + " \"REPL generated global variable.\")") + (slime-repl-send-input))) + (:one-liner "Define a new global, special, variable.")) + +(defslime-repl-shortcut slime-repl-compile-and-load ("compile-and-load" "cl") + (:handler (lambda (filename) + (interactive (list (expand-file-name + (read-file-name "File: " nil nil nil nil)))) + (save-some-buffers) + (slime-eval-async + `(swank:compile-file-if-needed + ,(slime-to-lisp-filename filename) t) + nil + (slime-compilation-finished-continuation)))) + (:one-liner "Compile (if neccessary) and load a lisp file.")) + +(defslime-repl-shortcut slime-repl-load/force-system ("force-load-system") + (:handler (lambda () + (interactive) + (slime-oos (slime-read-system-name) "LOAD-OP" :force t))) + (:one-liner "Recompile and load an ASDF system.")) + +(defslime-repl-shortcut slime-repl-load-system ("load-system") + (:handler (lambda () + (interactive) + (slime-oos (slime-read-system-name) "LOAD-OP"))) + (:one-liner "Compile (as needed) and load an ASDF system.")) + +(defslime-repl-shortcut slime-repl-compile-system ("compile-system") + (:handler (lambda () + (interactive) + (slime-oos (slime-read-system-name) "COMPILE-OP"))) + (:one-liner "Compile (but not load) an ASDF system.")) + +(defslime-repl-shortcut slime-repl-compile/force-system + ("force-compile-system") + (:handler (lambda () + (interactive) + (slime-oos (slime-read-system-name) "COMPILE-OP" :force t))) + (:one-liner "Recompile (but not load) an ASDF system.")) + + +;;;;; Cleanup after a quit + +(defun slime-kill-all-buffers () + "Kill all the slime related buffers. This is only used by the + repl command sayoonara." + (dolist (buf (buffer-list)) + (when (or (member (buffer-name buf) '("*inferior-lisp*" + slime-event-buffer-name)) + (string-match "^\\*slime-repl\\[[0-9]+\\]\\*$" (buffer-name buf)) + (string-match "^\\*sldb .*\\*$" (buffer-name buf))) + (kill-buffer buf)))) + + +;;; Scratch + +(defvar slime-scratch-mode-map) +(setq slime-scratch-mode-map (make-sparse-keymap)) +(set-keymap-parent slime-scratch-mode-map lisp-mode-map) + +(defun slime-scratch-buffer () + "Return the scratch buffer, create it if necessary." + (or (get-buffer "*slime-scratch*") + (with-current-buffer (get-buffer-create "*slime-scratch*") + (lisp-mode) + (use-local-map slime-scratch-mode-map) + (slime-mode t) + (current-buffer)))) + +(defun slime-switch-to-scratch-buffer () + (set-buffer (slime-scratch-buffer)) + (unless (eq (current-buffer) (window-buffer)) + (pop-to-buffer (current-buffer) t))) + +(defun slime-scratch () + (interactive) + (slime-switch-to-scratch-buffer)) + +(slime-define-keys slime-scratch-mode-map + ("\C-j" 'slime-eval-print-last-expression)) + + ;;; Filename translation (defun slime-to-lisp-filename (filename) @@ -3265,10 +3468,16 @@ ;; skip this sexp (slime-forward-sexp))))) +(defun slime-to-feature-keyword (symbol) + (let ((name (downcase (symbol-name symbol)))) + (intern (if (eq ?: (aref name 0)) + name + (concat ":" name))))) + (defun slime-eval-feature-conditional (e) "Interpret a reader conditional expression." (if (symbolp e) - (member* (symbol-name e) (slime-lisp-features) :test #'equalp) + (memq (slime-to-feature-keyword e) (slime-lisp-features)) (funcall (ecase (car e) (and #'every) (or #'some) @@ -3911,7 +4120,7 @@ (slime-buffer-package))) -;;;; `ED' +;;; `ED' (defvar slime-ed-frame nil "The frame used by `slime-ed'.") @@ -4132,7 +4341,7 @@ (slime-eval-with-transcript `(swank:load-file ,lisp-filename) nil))) -;;;; Profiling +;;; Profiling (defun slime-toggle-profile-fdefinition (fname-string) "Toggle profiling for FNAME-STRING." @@ -4831,7 +5040,7 @@ (lambda (result) (apply #'sldb-setup thread level result))))))) -;;; XXX thread is ignored +;; XXX thread is ignored (defun sldb-exit (thread level) (when-let (sldb (sldb-get-buffer)) (with-current-buffer sldb @@ -5836,6 +6045,7 @@ (setf end (point))) (indent-region start end nil))))) + ;;; Test suite (defvar slime-tests '() @@ -6044,206 +6254,6 @@ (put 'def-slime-test 'lisp-indent-function 4) (put 'slime-check 'lisp-indent-function 1) - -;;;; REPL handlers - -(defstruct (slime-repl-shortcut (:conc-name slime-repl-shortcut.)) - symbol names handler one-liner) - -(defvar slime-repl-shortcut-table nil - "A list of slime-repl-shortcuts") - -(defvar slime-repl-shortcut-history '() - "History list of shortcut command names.") - -(defun slime-handle-repl-shortcut () - (interactive) - (if (save-excursion - (goto-char slime-repl-input-start-mark) - (looking-at " *$")) - (let ((shortcut (slime-lookup-shortcut - (completing-read "Command: " - (slime-bogus-completion-alist - (slime-list-all-repl-shortcuts)) - nil t nil - 'slime-repl-shortcut-history)))) - (call-interactively (slime-repl-shortcut.handler shortcut))) - (insert (string slime-repl-shortcut-dispatch-char)))) - -(defun slime-list-all-repl-shortcuts () - (loop for shortcut in slime-repl-shortcut-table - append (slime-repl-shortcut.names shortcut))) - -(defun slime-lookup-shortcut (name) - (find-if (lambda (s) (member name (slime-repl-shortcut.names s))) - slime-repl-shortcut-table)) - -(defmacro defslime-repl-shortcut (elisp-name names &rest options) - "Define a new repl shortcut. ELISP-NAME is a symbol specifying - the name of the interactive function to create, or NIL if no - function should be created. NAMES is a list of (full-name . - aliases). OPTIONS is an olist specifying the handler and the - help text." - `(progn - ,(when elisp-name - `(defun ,elisp-name () - (interactive) - (call-interactively ,(second (assoc :handler options))))) - (let ((new-shortcut (make-slime-repl-shortcut - :symbol ',elisp-name - :names (list , at names) - ,@(apply #'append options)))) - (setq slime-repl-shortcut-table - (remove-if (lambda (s) - (member ',(car names) (slime-repl-shortcut.names s))) - slime-repl-shortcut-table)) - (push new-shortcut slime-repl-shortcut-table) - ',elisp-name))) - -(defun slime-list-repl-short-cuts () - (interactive) - (slime-with-output-to-temp-buffer "*slime-repl-help*" nil - (let ((table (sort* slime-repl-shortcut-table #'string< - :key (lambda (x) - (car (slime-repl-shortcut.names x)))))) - (dolist (shortcut table) - (let ((names (slime-repl-shortcut.names shortcut))) - (insert (pop names)) ;; first print the "full" name - (when names - ;; we also have aliases - (insert " (aka ") - (while (cdr names) - (insert (pop names) ", ")) - (insert (car names) ")")) - (insert "\n " (slime-repl-shortcut.one-liner shortcut) - "\n")))))) - -(defslime-repl-shortcut slime-repl-shortcut-help ("help" "?") - (:handler 'slime-list-repl-short-cuts) - (:one-liner "Display the help.")) - -(defslime-repl-shortcut nil ("change-directory" "!d" "cd") - (:handler 'slime-set-default-directory) - (:one-liner "Change the current directory.")) - -(defslime-repl-shortcut nil ("pwd") - (:handler (lambda () - (interactive) - (let ((dir (slime-eval `(swank:default-directory)))) - (message "Directory %s" dir)))) - (:one-liner "Change the current directory.")) - -(defslime-repl-shortcut slime-repl-push-directory ("push-directory" "+d" - "pushd") - (:handler (lambda (directory) - (interactive - (list (read-directory-name - "Push directory: " - (slime-eval '(swank:default-directory)) nil nil "")) - (push directory slime-repl-directory-stack) - (slime-set-default-directory directory)))) - (:one-liner "Push a new directory onto the directory stack.")) - -(defslime-repl-shortcut slime-repl-pop-directory ("pop-directory" "-d") - (:handler (lambda () - (interactive) - (unless (= 1 (length slime-repl-directory-stack)) - (pop slime-repl-directory-stack)) - (slime-set-default-directory (car slime-repl-directory-stack)))) - (:one-liner "Pop the current directory.")) - -(defslime-repl-shortcut nil ("change-package" "!p") - (:handler 'slime-repl-set-package) - (:one-liner "Change the current package.")) - -(defslime-repl-shortcut slime-repl-push-package ("push-package" "+p") - (:handler (lambda (package) - (interactive (list (slime-read-package-name "Package: "))) - (push package slime-repl-package-stack) - (slime-repl-set-package package))) - (:one-liner "Push a package onto the package stack.")) - -(defslime-repl-shortcut slime-repl-pop-package ("pop-package" "-p") - (:handler (lambda () - (interactive) - (unless (= 1 (length slime-repl-package-stack)) - (pop slime-repl-package-stack)) - (slime-repl-set-package (car slime-repl-package-stack)))) - (:one-liner "Pop the top of the package stack.")) - -(defslime-repl-shortcut slime-repl-resend ("resend-form") - (:handler (lambda () - (interactive) - (insert (car slime-repl-input-history)) - (insert "\n") - (slime-repl-send-input))) - (:one-liner "Resend the last form.")) - -(defslime-repl-shortcut slime-repl-sayoonara ("sayoonara" "quit") - (:handler (lambda () - (interactive) - (when (slime-connected-p) - (slime-eval-async '(swank:quit-lisp) nil (lambda (_) nil))) - (slime-kill-all-buffers))) - (:one-liner "Quit the lisp and close all SLIME buffers.")) - -(defslime-repl-shortcut slime-repl-defparameter ("defparameter" "!") - (:handler (lambda (name value) - (interactive (list (slime-read-symbol-name "Name (symbol): " t) - (slime-read-from-minibuffer "Value: " "nil"))) - (insert "(cl:defparameter " name " " value - " \"REPL generated global variable.\")") - (slime-repl-send-input))) - (:one-liner "Define a new global, special, variable.")) - -(defslime-repl-shortcut slime-repl-compile-and-load ("compile-and-load" "cl") - (:handler (lambda (filename) - (interactive (list (expand-file-name - (read-file-name "File: " nil nil nil nil)))) - (save-some-buffers) - (slime-eval-async - `(swank:compile-file-if-needed - ,(slime-to-lisp-filename filename) t) - nil - (slime-compilation-finished-continuation)))) - (:one-liner "Compile (if neccessary) and load a lisp file.")) - -(defslime-repl-shortcut slime-repl-load/force-system ("force-load-system") - (:handler (lambda () - (interactive) - (slime-oos (slime-read-system-name) "LOAD-OP" :force t))) - (:one-liner "Recompile and load an ASDF system.")) - -(defslime-repl-shortcut slime-repl-load-system ("load-system") - (:handler (lambda () - (interactive) - (slime-oos (slime-read-system-name) "LOAD-OP"))) - (:one-liner "Compile (as needed) and load an ASDF system.")) - -(defslime-repl-shortcut slime-repl-compile-system ("compile-system") - (:handler (lambda () - (interactive) - (slime-oos (slime-read-system-name) "COMPILE-OP"))) - (:one-liner "Compile (but not load) an ASDF system.")) - -(defslime-repl-shortcut slime-repl-compile/force-system - ("force-compile-system") - (:handler (lambda () - (interactive) - (slime-oos (slime-read-system-name) "COMPILE-OP" :force t))) - (:one-liner "Recompile (but not load) an ASDF system.")) - -;;;; Cleanup after a quit - -(defun slime-kill-all-buffers () - "Kill all the slime related buffers. This is only used by the - repl command sayoonara." - (dolist (buf (buffer-list)) - (when (or (member (buffer-name buf) '("*inferior-lisp*" - slime-event-buffer-name)) - (string-match "^\\*slime-repl\\[[0-9]+\\]\\*$" (buffer-name buf)) - (string-match "^\\*sldb .*\\*$" (buffer-name buf))) - (kill-buffer buf)))) ;;;;; Test case definitions From heller at common-lisp.net Sun Jun 20 13:51:47 2004 From: heller at common-lisp.net (Helmut Eller) Date: Sun, 20 Jun 2004 06:51:47 -0700 Subject: [slime-cvs] CVS update: slime/ChangeLog Message-ID: Update of /project/slime/cvsroot/slime In directory common-lisp.net:/tmp/cvs-serv8097 Modified Files: ChangeLog Log Message: *** empty log message *** Date: Sun Jun 20 06:51:47 2004 Author: heller Index: slime/ChangeLog diff -u slime/ChangeLog:1.411 slime/ChangeLog:1.412 --- slime/ChangeLog:1.411 Sat Jun 19 22:49:08 2004 +++ slime/ChangeLog Sun Jun 20 06:51:47 2004 @@ -1,3 +1,10 @@ +2004-06-20 Helmut Eller + + * slime.el: Fix outline structure. + + * slime.el (slime-eval-feature-conditional) + (slime-to-feature-keyword): Add a ?: to the symbol-name if needed. + 2004-06-20 Luke Gorrie * swank.lisp (changelog-date): Removed unneeded function. From heller at common-lisp.net Sun Jun 20 13:55:16 2004 From: heller at common-lisp.net (Helmut Eller) Date: Sun, 20 Jun 2004 06:55:16 -0700 Subject: [slime-cvs] CVS update: slime/swank.lisp Message-ID: Update of /project/slime/cvsroot/slime In directory common-lisp.net:/tmp/cvs-serv11825 Modified Files: swank.lisp Log Message: (guess-buffer-package): Don't signal a continuable error if the package doesn't exists; that's too annoying. Date: Sun Jun 20 06:55:16 2004 Author: heller Index: slime/swank.lisp diff -u slime/swank.lisp:1.194 slime/swank.lisp:1.195 --- slime/swank.lisp:1.194 Sat Jun 19 22:47:32 2004 +++ slime/swank.lisp Sun Jun 20 06:55:16 2004 @@ -1126,16 +1126,9 @@ (defun guess-buffer-package (string) "Return a package for STRING. -Print a warning if STRING is not nil but no such package exists." - (cond ((guess-package-from-string string nil)) - (string - (cerror (format nil "Use current package. [~A]" - (package-name *package*)) - "Package ~A not found." - string (package-name *package*)) - *package*) - (t - *package*))) +Fall back to the the current if no such package exists." + (or (guess-package-from-string string nil) + *package*)) (defun eval-for-emacs (form buffer-package id) "Bind *BUFFER-PACKAGE* BUFFER-PACKAGE and evaluate FORM. @@ -1159,8 +1152,9 @@ (defun format-values-for-echo-area (values) (with-buffer-syntax () - (cond (values (format nil "~{~S~^, ~}" values)) - (t "; No value")))) + (let ((*print-readably* nil)) + (cond (values (format nil "~{~S~^, ~}" values)) + (t "; No value"))))) (defslimefun interactive-eval (string) (with-buffer-syntax () @@ -1365,6 +1359,29 @@ :type "asd" :name :wild :case :local))))) + +(defun file-newer-p (new-file old-file) + "Returns true if NEW-FILE is newer than OLD-FILE." + (> (file-write-date new-file) (file-write-date old-file))) + +(defun requires-compile-p (source-file) + (let ((fasl-file (probe-file (compile-file-pathname source-file)))) + (or (not fasl-file) + (file-newer-p source-file fasl-file)))) + +(defslimefun compile-file-if-needed (filename loadp) + (cond ((requires-compile-p filename) + (compile-file-for-emacs filename loadp)) + (loadp + (load (compile-file-pathname filename)) + nil))) + + +;;;; Loading + +(defslimefun load-file (filename) + (to-string (load filename))) + ;;;; Macroexpansion @@ -1760,7 +1777,7 @@ default)))) -;;;; +;;;; Package Commands (defslimefun list-all-package-names (&optional include-nicknames) "Return a list of all package names. @@ -1769,6 +1786,9 @@ collect (package-name package) when include-nicknames append (package-nicknames package))) + +;;;; Tracing + ;; Use eval for the sake of portability... (defun tracedp (fspec) (member fspec (eval '(trace)))) @@ -1785,29 +1805,13 @@ (defslimefun untrace-all () (untrace)) + +;;;; Undefing + (defslimefun undefine-function (fname-string) (let ((fname (from-string fname-string))) (format nil "~S" (fmakunbound fname)))) -(defslimefun load-file (filename) - (to-string (load filename))) - -(defun file-newer-p (new-file old-file) - "Returns true if NEW-FILE is newer than OLD-FILE." - (> (file-write-date new-file) (file-write-date old-file))) - -(defun requires-compile-p (source-file) - (let ((fasl-file (probe-file (compile-file-pathname source-file)))) - (or (not fasl-file) - (file-newer-p source-file fasl-file)))) - -(defslimefun compile-file-if-needed (filename loadp) - (cond ((requires-compile-p filename) - (compile-file-for-emacs filename loadp)) - (loadp - (load (compile-file-pathname filename)) - nil))) - ;;;; Profiling From heller at common-lisp.net Sun Jun 20 14:39:01 2004 From: heller at common-lisp.net (Helmut Eller) Date: Sun, 20 Jun 2004 07:39:01 -0700 Subject: [slime-cvs] CVS update: slime/ChangeLog Message-ID: Update of /project/slime/cvsroot/slime In directory common-lisp.net:/tmp/cvs-serv21239 Modified Files: ChangeLog Log Message: *** empty log message *** Date: Sun Jun 20 07:39:01 2004 Author: heller Index: slime/ChangeLog diff -u slime/ChangeLog:1.412 slime/ChangeLog:1.413 --- slime/ChangeLog:1.412 Sun Jun 20 06:51:47 2004 +++ slime/ChangeLog Sun Jun 20 07:39:01 2004 @@ -1,5 +1,12 @@ 2004-06-20 Helmut Eller + * swank-sbcl.lisp (emacs-connected): Set *invoke-debugger-hook* to + our debugger hook. Not optimal, but at least BREAK will then + invoke our debugger. + + * swank.lisp (guess-buffer-package): Don't signal a continuable + error if the package doesn't exists; that's too annoying. + * slime.el: Fix outline structure. * slime.el (slime-eval-feature-conditional) From heller at common-lisp.net Sun Jun 20 21:31:48 2004 From: heller at common-lisp.net (Helmut Eller) Date: Sun, 20 Jun 2004 14:31:48 -0700 Subject: [slime-cvs] CVS update: slime/slime.el Message-ID: Update of /project/slime/cvsroot/slime In directory common-lisp.net:/tmp/cvs-serv22355 Modified Files: slime.el Log Message: (slime-find-buffer-package): Return the printed representation of the package designator; until now there was no way to distinguish NIL from the package names "NIL". (slime-maybe-list-compiler-notes): Fix thinko. (break): New test. Reorganize the test-suite a bit to support "expected failures". Date: Sun Jun 20 14:31:48 2004 Author: heller Index: slime/slime.el diff -u slime/slime.el:1.325 slime/slime.el:1.326 --- slime/slime.el:1.325 Sun Jun 20 06:39:39 2004 +++ slime/slime.el Sun Jun 20 14:31:48 2004 @@ -773,10 +773,8 @@ (goto-char (match-end 0)) (skip-chars-forward " \n\t\f\r#") (let ((pkg (ignore-errors (read (current-buffer))))) - (cond ((stringp pkg) - pkg) - ((symbolp pkg) - (symbol-name pkg))))))) + (if pkg + (format "%S" pkg)))))) (defun slime-display-buffer-other-window (buffer &optional not-this-window) "Display BUFFER in some other window. @@ -3015,14 +3013,15 @@ (slime-show-xrefs xrefs 'definition "Compiler notes" (slime-buffer-package))))) +(defun slime-note-has-location-p (note) + (not (eq ':error (car (slime-note.location note))))) + (defun slime-maybe-list-compiler-notes (notes) "Show the compiler notes if appropriate. Useful value for `slime-compilation-finished-hook'" (unless (or (null notes) (and (eq last-command 'slime-compile-defun) - (some (lambda (x) - (not (eq ':error (car (slime-note.location x))))) - notes))) + (every #'slime-note-has-location-p notes))) (slime-list-compiler-notes notes))) (defun slime-list-compiler-notes (&optional notes) @@ -3822,6 +3821,9 @@ ;;; Completion +;; XXX those long names are ugly to read; long names an indicator for +;; bad factoring? + (defvar slime-completions-buffer-name "*Completions*") (defvar slime-complete-saved-window-configuration nil @@ -4515,8 +4517,7 @@ (:alien-type "Alien type") (:alien-struct "Alien struct") (:alien-union "Alien type") - (:alien-enum "Alien enum") - ) + (:alien-enum "Alien enum")) do (let ((value (plist-get plist prop)) (start (point))) @@ -6048,6 +6049,9 @@ ;;; Test suite +(defstruct (slime-test (:conc-name slime-test.)) + name fname args doc inputs fails-for) + (defvar slime-tests '() "Names of test functions.") @@ -6097,46 +6101,55 @@ (goto-char (overlay-start o)) (show-subtree))))) +(defun slime-test-should-fail-p (test) + (member (slime-lisp-implementation-type-name) + (slime-test.fails-for test))) + (defun slime-execute-tests () "Execute each test case with each input. Return the number of failed tests." (save-window-excursion (let ((slime-total-tests 0) - (slime-failed-tests 0)) - (loop for (name function inputs) in slime-tests - do (progn - (slime-test-heading 1 "%s" name) - (dolist (input inputs) - (incf slime-total-tests) - (slime-test-heading 2 "input: %s" input) - (if slime-test-debug-on-error - (let ((debug-on-error t) - (debug-on-quit t)) - (apply function input)) - (condition-case err - (apply function input) - (error - (when slime-test-debug-on-error - (debug (format "Error in test: %S" err))) - (incf slime-failed-tests) - (slime-print-check-error err))))))) - (let ((summary (cond ((zerop slime-failed-tests) + (slime-expected-passes 0) + (slime-unexpected-failures 0) + (slime-expected-failures 0)) + (dolist (slime-current-test slime-tests) + (with-struct (slime-test. name (function fname) inputs) + slime-current-test + (slime-test-heading 1 "%s" name) + (dolist (input inputs) + (incf slime-total-tests) + (slime-test-heading 2 "input: %s" input) + (if slime-test-debug-on-error + (let ((debug-on-error t) + (debug-on-quit t)) + (apply function input)) + (condition-case err + (apply function input) + (error + (cond ((slime-test-should-fail-p slime-current-test) + (incf slime-expected-failures) + (slime-test-failure "ERROR (expected)" + (format "%S" err))) + (t + (incf slime-unexpected-failures) + (slime-print-check-error err))))))))) + (let ((summary (cond ((and (zerop slime-expected-failures) + (zerop slime-unexpected-failures)) (format "All %S tests completed successfully." slime-total-tests)) - ((plusp (slime-expected-failures)) - (format "Failed on %S (%S expected) of %S tests." - slime-failed-tests - (slime-expected-failures) - slime-total-tests)) (t - (format "Failed on %S of %S tests." - slime-failed-tests slime-total-tests))))) + (format "Failed on %S (%S expected) of %S tests." + (+ slime-expected-failures + slime-unexpected-failures) + slime-expected-failures + slime-total-tests))))) (save-excursion (with-current-buffer slime-test-buffer-name (goto-char (point-min)) (insert summary "\n\n"))) (message "%s" summary) - slime-failed-tests)))) + slime-unexpected-failures)))) (defun slime-batch-test (results-file) "Run the test suite in batch-mode. @@ -6212,20 +6225,26 @@ (defmacro def-slime-test (name args doc inputs &rest body) "Define a test case. -NAME is a symbol naming the test. +NAME ::= SYMBOL | (SYMBOL (FAILS-FOR*)) is a symbol naming the test. ARGS is a lambda-list. DOC is a docstring. INPUTS is a list of argument lists, each tested separately. BODY is the test case. The body can use `slime-check' to test conditions (assertions)." - (let ((fname (intern (format "slime-test-%s" name)))) - `(progn - (defun ,fname ,args - ,doc - (slime-sync) - , at body) - (setq slime-tests (append (remove* ',name slime-tests :key 'car) - (list (list ',name ',fname ,inputs))))))) + (multiple-value-bind (name fails-for) (etypecase name + (symbol (values name '())) + (cons name)) + (let ((fname (intern (format "slime-test-%s" name)))) + `(progn + (defun ,fname ,args + ,doc + (slime-sync) + , at body) + (setq slime-tests + (append (remove* ',name slime-tests :key 'slime-test.name) + (list (make-slime-test :name ',name :fname ',fname + :fails-for ',fails-for + :inputs ,inputs)))))))) (defmacro slime-check (test-name &rest body) "Check a condition (assertion.) @@ -6238,8 +6257,12 @@ (cons `(format , at test-name))))) (if (progn , at body) (slime-print-check-ok ,check-name) - (incf slime-failed-tests) - (slime-print-check-failed ,check-name) + (cond ((slime-test-should-fail-p slime-current-test) + (incf slime-expected-failures) + (slime-test-failure "FAIL (expected)" ,check-name)) + (t + (incf slime-unexpected-failures) + (slime-print-check-failed ,check-name))) (when slime-test-debug-on-error (debug (format "Check failed: %S" ,check-name))))))) @@ -6298,6 +6321,11 @@ (with-current-buffer sldb sldb-level))) +(defun slime-sldb-level= (level) + (when-let (sldb (sldb-get-buffer)) + (with-current-buffer sldb + (equal sldb-level level)))) + (def-slime-test find-definition (name buffer-package) "Find the definition of a function or macro in swank.lisp." @@ -6336,11 +6364,8 @@ "cl::compile-file")) ("cl:m-v-l" (("cl:multiple-value-list" "cl:multiple-values-limit") "cl:multiple-value-li"))) - (slime-check-top-level) (let ((completions (slime-completions prefix))) - (slime-check "Completion set is as expected." - (equal expected-completions completions))) - (slime-check-top-level)) + (slime-test-expect "Completion set" expected-completions completions))) (def-slime-test arglist (function-name expected-arglist) @@ -6353,11 +6378,11 @@ ("swank::create-socket" "(swank::create-socket host port)") ("swank::emacs-connected" - "(swank::emacs-connected)") + "(swank::emacs-connected stream)") ("swank::compile-string-for-emacs" "(swank::compile-string-for-emacs string buffer position)") ("swank::connection.socket-io" - "(swank::connection.socket-io structure)") + "(swank::connection.socket-io \\(struct\\(ure\\)?\\|object\\|instance\\))") ("cl:lisp-implementation-type" "(cl:lisp-implementation-type)") ) @@ -6367,10 +6392,11 @@ (slime-check-top-level) (let ((arglist (slime-get-arglist function-name))) ; (slime-test-expect "Argument list is as expected" - expected-arglist arglist)) + expected-arglist arglist + #'string-match)) (slime-check-top-level)) -(def-slime-test compile-defun +(def-slime-test (compile-defun ("allegro" "lispworks" "clisp")) (program subform) "Compile PROGRAM containing errors. Confirm that SUBFORM is correctly located." @@ -6432,11 +6458,6 @@ debug-hook-max-depth depth) (= debug-hook-max-depth depth)))))) -(defun slime-sldb-level= (level) - (when-let (sldb (sldb-get-buffer)) - (with-current-buffer sldb - (equal sldb-level level)))) - (def-slime-test loop-interrupt-quit () "Test interrupting a loop." @@ -6648,6 +6669,23 @@ visiblep (not (not (get-buffer-window (current-buffer))))))) +(def-slime-test break + () + "Test if BREAK invokes SLDB." + '(()) + (slime-compile-string (prin1-to-string '(cl:defun cl-user::foo () + (cl:break))) + 0) + (slime-eval-async '(cl-user::foo) nil (lambda (_))) + (slime-wait-condition "Debugger visible" + (lambda () + (and (slime-sldb-level= 1) + (get-buffer-window (sldb-get-buffer)))) + 5) + (with-current-buffer (sldb-get-buffer) + (sldb-quit)) + (slime-sync-to-top-level 5)) + ;;; Portability library From heller at common-lisp.net Sun Jun 20 21:33:05 2004 From: heller at common-lisp.net (Helmut Eller) Date: Sun, 20 Jun 2004 14:33:05 -0700 Subject: [slime-cvs] CVS update: slime/swank.lisp Message-ID: Update of /project/slime/cvsroot/slime In directory common-lisp.net:/tmp/cvs-serv23325 Modified Files: swank.lisp Log Message: (parse-symbol): Allow strings and symbols as package designators. Date: Sun Jun 20 14:33:05 2004 Author: heller Index: slime/swank.lisp diff -u slime/swank.lisp:1.195 slime/swank.lisp:1.196 --- slime/swank.lisp:1.195 Sun Jun 20 06:55:16 2004 +++ slime/swank.lisp Sun Jun 20 14:33:05 2004 @@ -784,13 +784,14 @@ (defun parse-package (string) "Find the package named STRING. Return the package or nil." - (multiple-value-bind (sym pos) + (multiple-value-bind (name pos) (if (zerop (length string)) (values :|| 0) (let ((*package* keyword-package)) (ignore-errors (read-from-string string)))) - (if (and (keywordp sym) (= (length string) pos)) - (find-package sym)))) + (if (and (or (keywordp name) (stringp name)) + (= (length string) pos)) + (find-package name)))) (defun to-string (string) "Write string in the *BUFFER-PACKAGE*." From heller at common-lisp.net Sun Jun 20 21:37:05 2004 From: heller at common-lisp.net (Helmut Eller) Date: Sun, 20 Jun 2004 14:37:05 -0700 Subject: [slime-cvs] CVS update: slime/swank-sbcl.lisp Message-ID: Update of /project/slime/cvsroot/slime In directory common-lisp.net:/tmp/cvs-serv30667 Modified Files: swank-sbcl.lisp Log Message: (*trap-load-time-warnings*): New variable. If it is true, conditions, most notably redefinition warnings, signalled at load time are not trapped. (swank-compile-file, swank-compile-string): Use it. Date: Sun Jun 20 14:37:05 2004 Author: heller Index: slime/swank-sbcl.lisp diff -u slime/swank-sbcl.lisp:1.90 slime/swank-sbcl.lisp:1.91 --- slime/swank-sbcl.lisp:1.90 Wed Jun 16 13:26:01 2004 +++ slime/swank-sbcl.lisp Sun Jun 20 14:37:05 2004 @@ -128,6 +128,11 @@ (return (sb-bsd-sockets:socket-accept socket)) (sb-bsd-sockets:interrupted-error ())))) +(defimplementation emacs-connected (stream) + (declare (ignore stream)) + (setq sb-ext:*invoke-debugger-hook* + (find-symbol (string :swank-debugger-hook) (find-package :swank)))) + (defmethod call-without-interrupts (fn) (declare (type function fn)) (sb-sys:without-interrupts (funcall fn))) @@ -268,19 +273,29 @@ (warning #'handle-notification-condition)) (funcall function))) +(defvar *trap-load-time-warnings* nil) + (defimplementation swank-compile-file (filename load-p) - (with-compilation-hooks () - (let ((fasl-file (compile-file filename))) - (when (and load-p fasl-file) - (load fasl-file))))) + (flet ((loadit (fasl-file) (when (and load-p fasl-file) (load fasl-file)))) + (cond (*trap-load-time-warnings* + (with-compilation-hooks () + (loadit (compile-file filename)))) + (t + (loadit (with-compilation-hooks () + (compile-file filename))))))) (defimplementation swank-compile-string (string &key buffer position) - (with-compilation-hooks () - (let ((*buffer-name* buffer) - (*buffer-offset* position) - (*buffer-substring* string)) - (funcall (compile nil (read-from-string - (format nil "(~S () ~A)" 'lambda string))))))) + (let ((form (read-from-string (format nil "(~S () ~A)" 'lambda string)))) + (flet ((compileit (cont) + (with-compilation-hooks () + (let ((*buffer-name* buffer) + (*buffer-offset* position) + (*buffer-substring* string)) + (funcall cont (compile nil form)))))) + (cond (*trap-load-time-warnings* + (compileit #'funcall)) + (t + (funcall (compileit #'identity))))))) ;;;; Definitions From heller at common-lisp.net Sun Jun 20 21:39:32 2004 From: heller at common-lisp.net (Helmut Eller) Date: Sun, 20 Jun 2004 14:39:32 -0700 Subject: [slime-cvs] CVS update: slime/ChangeLog Message-ID: Update of /project/slime/cvsroot/slime In directory common-lisp.net:/tmp/cvs-serv2653 Modified Files: ChangeLog Log Message: *** empty log message *** Date: Sun Jun 20 14:39:32 2004 Author: heller Index: slime/ChangeLog diff -u slime/ChangeLog:1.413 slime/ChangeLog:1.414 --- slime/ChangeLog:1.413 Sun Jun 20 07:39:01 2004 +++ slime/ChangeLog Sun Jun 20 14:39:32 2004 @@ -3,14 +3,20 @@ * swank-sbcl.lisp (emacs-connected): Set *invoke-debugger-hook* to our debugger hook. Not optimal, but at least BREAK will then invoke our debugger. - + (*trap-load-time-warnings*): New variable. If it is true, + conditions, most notably redefinition warnings, signalled at load + time are not trapped. + (swank-compile-file, swank-compile-string): Use it. + * swank.lisp (guess-buffer-package): Don't signal a continuable error if the package doesn't exists; that's too annoying. * slime.el: Fix outline structure. - - * slime.el (slime-eval-feature-conditional) - (slime-to-feature-keyword): Add a ?: to the symbol-name if needed. + (slime-maybe-list-compiler-notes): Fix thinko. + (break): New test. Reorganize the test-suite a bit to support + "expected failures". + (slime-eval-feature-conditional, slime-to-feature-keyword): Add a + ?: to the symbol-name if needed. 2004-06-20 Luke Gorrie From lgorrie at common-lisp.net Mon Jun 21 01:29:29 2004 From: lgorrie at common-lisp.net (Luke Gorrie) Date: Sun, 20 Jun 2004 18:29:29 -0700 Subject: [slime-cvs] CVS update: slime/slime.el Message-ID: Update of /project/slime/cvsroot/slime In directory common-lisp.net:/tmp/cvs-serv6667 Modified Files: slime.el Log Message: (slime-complete-maybe-restore-window-configuration): Only restore the window configuration if the completions buffer is currently visible in the window that we popped it up in. (slime-complete-maybe-save-window-configuration): Don't save the window configuration if the completions buffer is already visible. Date: Sun Jun 20 18:29:28 2004 Author: lgorrie Index: slime/slime.el diff -u slime/slime.el:1.326 slime/slime.el:1.327 --- slime/slime.el:1.326 Sun Jun 20 14:31:48 2004 +++ slime/slime.el Sun Jun 20 18:29:28 2004 @@ -3826,16 +3826,26 @@ (defvar slime-completions-buffer-name "*Completions*") -(defvar slime-complete-saved-window-configuration nil - "Window configuration before we show the *Completions* buffer. +(make-variable-buffer-local + (defvar slime-complete-saved-window-configuration nil + "Window configuration before we show the *Completions* buffer. This is buffer local in the buffer where the completion is -performed.") +performed.")) + +(make-variable-buffer-local + (defvar slime-completions-window nil + "The window displaying *Completions* after saving window configuration. +If this window is no longer active or displaying the completions +buffer then we can ignore `slime-complete-saved-window-configuration'.")) (defun slime-complete-maybe-save-window-configuration () - (make-local-variable 'slime-complete-saved-window-configuration) - (unless slime-complete-saved-window-configuration + "Maybe save the current window configuration. +Return true if the configuration was saved." + (unless (or slime-complete-saved-window-configuration + (get-buffer-window slime-completions-buffer-name)) (setq slime-complete-saved-window-configuration - (current-window-configuration)))) + (current-window-configuration)) + t)) (defun slime-complete-delay-restoration () (make-local-hook 'pre-command-hook) @@ -3843,13 +3853,15 @@ 'slime-complete-maybe-restore-window-configuration)) (defun slime-complete-forget-window-configuration () - (setq slime-complete-saved-window-configuration nil)) + (setq slime-complete-saved-window-configuration nil) + (setq slime-completions-window nil)) (defun slime-complete-restore-window-configuration () "Restore the window config if available." (remove-hook 'pre-command-hook 'slime-complete-maybe-restore-window-configuration) - (when slime-complete-saved-window-configuration + (when (and slime-complete-saved-window-configuration + (slime-completion-window-active-p)) (save-excursion (set-window-configuration slime-complete-saved-window-configuration)) (setq slime-complete-saved-window-configuration nil) @@ -3863,25 +3875,30 @@ (condition-case err (cond ((find last-command-char "()\"'`,# \r\n:") (slime-complete-restore-window-configuration)) - ((memq this-command '(self-insert-command - slime-complete-symbol - slime-indent-and-complete-symbol - backward-delete-char-untabify - backward-delete-char - scroll-other-window)) - (slime-complete-delay-restoration)) - (t - (slime-complete-forget-window-configuration))) + ((not (slime-completion-window-active-p)) + (slime-complete-forget-window-configuration)) + (t + (slime-complete-delay-restoration))) (error ;; Because this is called on the pre-command-hook, we mustn't let ;; errors propagate. - (message "Error in slime-complete-forget-window-configuration: %S" err)))) + (message "Error in slime-complete-restore-window-configuration: %S" err)))) + +(defun slime-completion-window-active-p () + "Is the completion window currently active?" + (and (window-live-p slime-completions-window) + (equal (buffer-name (window-buffer slime-completions-window)) + slime-completions-buffer-name))) (defun slime-display-completion-list (completion-list) - (with-output-to-temp-buffer "*Completions*" - (display-completion-list completion-set) - (with-current-buffer standard-output - (set-syntax-table lisp-mode-syntax-table)))) + (let ((savedp (slime-complete-maybe-save-window-configuration))) + (with-output-to-temp-buffer slime-completions-buffer-name + (display-completion-list completion-set) + (with-current-buffer standard-output + (set-syntax-table lisp-mode-syntax-table))) + (when savedp + (setq slime-completions-window + (get-buffer-window slime-completions-buffer-name))))) (defun slime-complete-symbol () "Complete the symbol at point. @@ -3924,7 +3941,6 @@ minimizing (or (mismatch completed-prefix c) (length completed-prefix))))) (goto-char (+ beg unambiguous-completion-length)) - (slime-complete-maybe-save-window-configuration) (slime-display-completion-list completion-set) (slime-complete-delay-restoration))))))) @@ -3951,10 +3967,9 @@ ;; Incomplete (t (slime-minibuffer-respecting-message "Complete but not unique") - (slime-complete-maybe-save-window-configuration) (slime-display-completion-list completion-set) (slime-complete-delay-restoration))))))) - + (defun slime-minibuffer-respecting-message (format &rest format-args) "Display TEXT as a message, without hiding any minibuffer contents." (let ((text (format " [%s]" (apply #'format format format-args)))) From lgorrie at common-lisp.net Mon Jun 21 03:15:28 2004 From: lgorrie at common-lisp.net (Luke Gorrie) Date: Sun, 20 Jun 2004 20:15:28 -0700 Subject: [slime-cvs] CVS update: slime/slime.el Message-ID: Update of /project/slime/cvsroot/slime In directory common-lisp.net:/tmp/cvs-serv32499 Modified Files: slime.el Log Message: (slime-repl-return): Make sure the newline goes at the end of the input, not at point. (slime-complete-restore-window-configuration): Wrap the `set-window-configuration' call in (run-at-time 0 ..). XEmacs does not allow us to set the window configuration from inside pre-command-hook. Date: Sun Jun 20 20:15:28 2004 Author: lgorrie Index: slime/slime.el diff -u slime/slime.el:1.327 slime/slime.el:1.328 --- slime/slime.el:1.327 Sun Jun 20 18:29:28 2004 +++ slime/slime.el Sun Jun 20 20:15:28 2004 @@ -2284,22 +2284,22 @@ (current-prefix-arg (slime-repl-send-input)) (slime-repl-read-mode ; bad style? - (insert "\n") - (slime-repl-send-input)) + (slime-repl-send-input t)) ((slime-input-complete-p slime-repl-input-start-mark slime-repl-input-end-mark) - (insert "\n") - (slime-repl-send-input)) + (slime-repl-send-input t)) (t (slime-repl-newline-and-indent) (message "[input not complete]")))) -(defun slime-repl-send-input () - "Goto to the end of the input and send the current input." +(defun slime-repl-send-input (&optional newline) + "Goto to the end of the input and send the current input. +If NEWLINE is true then add a newline at the end of the input." (when (< (point) slime-repl-input-start-mark) (error "No input at point.")) (let ((input (slime-repl-current-input))) (goto-char slime-repl-input-end-mark) + (when newline (insert "\n")) (add-text-properties slime-repl-input-start-mark (point) '(face slime-repl-input-face rear-nonsticky (face) @@ -3862,10 +3862,16 @@ 'slime-complete-maybe-restore-window-configuration) (when (and slime-complete-saved-window-configuration (slime-completion-window-active-p)) - (save-excursion - (set-window-configuration slime-complete-saved-window-configuration)) - (setq slime-complete-saved-window-configuration nil) - (slime-close-buffer slime-completions-buffer-name))) + ;; XEmacs does not allow us to restore a window configuration from + ;; pre-command-hook, so we do it asynchronously. + (run-at-time + 0 nil + (lambda () + (save-excursion + (set-window-configuration + slime-complete-saved-window-configuration)) + (setq slime-complete-saved-window-configuration nil) + (slime-close-buffer slime-completions-buffer-name))))) (defun slime-complete-maybe-restore-window-configuration () "Restore the window configuration, if the following command From lgorrie at common-lisp.net Mon Jun 21 03:16:07 2004 From: lgorrie at common-lisp.net (Luke Gorrie) Date: Sun, 20 Jun 2004 20:16:07 -0700 Subject: [slime-cvs] CVS update: slime/ChangeLog Message-ID: Update of /project/slime/cvsroot/slime In directory common-lisp.net:/tmp/cvs-serv1557 Modified Files: ChangeLog Log Message: *** empty log message *** Date: Sun Jun 20 20:16:07 2004 Author: lgorrie Index: slime/ChangeLog diff -u slime/ChangeLog:1.414 slime/ChangeLog:1.415 --- slime/ChangeLog:1.414 Sun Jun 20 14:39:32 2004 +++ slime/ChangeLog Sun Jun 20 20:16:07 2004 @@ -1,3 +1,17 @@ +2004-06-21 Luke Gorrie + + * slime.el (slime-complete-maybe-restore-window-configuration): + Only restore the window configuration if the completions buffer is + currently visible in the window that we popped it up in. + (slime-complete-maybe-save-window-configuration): Don't save the + window configuration if the completions buffer is already visible. + (slime-repl-return): Make sure the newline goes at the end of the + input, not at point. + (slime-complete-restore-window-configuration): Wrap the + `set-window-configuration' call in (run-at-time 0 ..). XEmacs does + not allow us to set the window configuration from inside + pre-command-hook. + 2004-06-20 Helmut Eller * swank-sbcl.lisp (emacs-connected): Set *invoke-debugger-hook* to From lgorrie at common-lisp.net Mon Jun 21 06:12:04 2004 From: lgorrie at common-lisp.net (Luke Gorrie) Date: Sun, 20 Jun 2004 23:12:04 -0700 Subject: [slime-cvs] CVS update: slime/swank.lisp Message-ID: Update of /project/slime/cvsroot/slime In directory common-lisp.net:/tmp/cvs-serv8992 Modified Files: swank.lisp Log Message: (add-hook, run-hook): Moved the hook mechanism and all hooks here (from swank-backend.lisp). There is no compelling use for backends yet, I want to pass swank.lisp-internal data structures in the existing hooks. (notify-backend-of-connection): Call `emacs-connected' with the socket-io stream for its argument. Should fix previous breakage where the connection structure was passed instead. (*globally-redirect-io*): New configurable: when true the standard streams are globally redirected to Emacs. That way even e.g. SERVE-EVENT handlers will print to Emacs. Currently does not handle standard input -- that is trickier since the Lisp's native REPL can be trying to read from that. Date: Sun Jun 20 23:12:04 2004 Author: lgorrie Index: slime/swank.lisp diff -u slime/swank.lisp:1.196 slime/swank.lisp:1.197 --- slime/swank.lisp:1.196 Sun Jun 20 14:33:05 2004 +++ slime/swank.lisp Sun Jun 20 23:12:04 2004 @@ -28,6 +28,7 @@ #:*use-dedicated-output-stream* #:*configure-emacs-indentation* #:*readtable-alist* + #:*globally-redirect-io* ;; These are re-exported directly from the backend: #:frame-source-location-for-emacs #:restart-frame @@ -85,7 +86,34 @@ include some arbitrary initial value like NIL." (error "A required &KEY or &OPTIONAL argument was not supplied.")) - +;;;; Hooks +;;; +;;; We use Emacs-like `add-hook' and `run-hook' utilities to support +;;; simple indirection. The interface is more CLish than the Emacs +;;; Lisp one. + +(defmacro add-hook (place function) + "Add FUNCTION to the list of values on HOOK-VARIABLE." + `(pushnew ,function ,place)) + +(defun run-hook (functions &rest arguments) + "Call each of FUNCTIONS with ARGUMENTS." + (dolist (function functions) + (apply function arguments))) + +(defvar *new-connection-hook* '() + "This hook is run each time a connection is established. +The connection structure is given as the argument. +Backend code should treat the connection structure as opaque.") + +(defvar *connection-closed-hook* '() + "This hook is run when a connection is closed. +The connection as passed as an argument. +Backend code should treat the connection structure as opaque.") + +(defvar *pre-reply-hook* '() + "Hook run (without arguments) immediately before replying to an RPC.") + ;;;; Connections ;;; ;;; Connection structures represent the network connections between @@ -164,6 +192,10 @@ (:report (lambda (condition stream) (format stream "~A" (slime-read-error.condition condition))))) +(add-hook *new-connection-hook* 'notify-backend-of-connection) +(defun notify-backend-of-connection (connection) + (emacs-connected (connection.socket-io connection))) + ;;;; Helper macros (defmacro with-io-redirection ((connection) &body body) @@ -359,7 +391,8 @@ (close (connection.socket-io c)) (when (connection.dedicated-output c) (close (connection.dedicated-output c))) - (setf *connections* (remove c *connections*))) + (setf *connections* (remove c *connections*)) + (run-hook *connection-closed-hook* c)) (defmacro with-reader-error-handler ((connection) &body body) `(handler-case (progn , at body) @@ -615,10 +648,148 @@ ;;;; IO to Emacs ;;; -;;; The lower layer is a socket connection. Emacs sends us forms to -;;; evaluate, and we accept these by calling READ-FROM-EMACS. These -;;; evaluations can send messages back to Emacs as a side-effect by -;;; calling SEND-TO-EMACS. +;;; This code handles redirection of the standard I/O streams +;;; (`*standard-output*', etc) into Emacs. The `connection' structure +;;; contains the appropriate streams, so all we have to do is make the +;;; right bindings. + +;;;;; Global I/O redirection framework +;;; +;;; Optionally, the top-level global bindings of the standard streams +;;; can be assigned to be redirected to Emacs. When Emacs connects we +;;; redirect the streams into the connection, and they keep going into +;;; that connection even if more are established. If the connection +;;; handling the streams closes then another is chosen, or if there +;;; are no connections then we revert to the original (real) streams. +;;; +;;; It is slightly tricky to assign the global values of standard +;;; streams because they are often shadowed by dynamic bindings. We +;;; solve this problem by introducing an extra indirection via synonym +;;; streams, so that *STANDARD-INPUT* is a synonym stream to +;;; *CURRENT-STANDARD-INPUT*, etc. We never shadow the "current" +;;; variables, so they can always be assigned to affect a global +;;; change. + +(defvar *globally-redirect-io* nil + "When non-nil globally redirect all standard streams to Emacs.") + +(defmacro setup-stream-indirection (stream-var) + "Setup redirection scaffolding for a global stream variable. +Supposing (for example) STREAM-VAR is *STANDARD-INPUT*, this macro: + +1. Saves the value of *STANDARD-INPUT* in a variable called +*REAL-STANDARD-INPUT*. + +2. Creates *CURRENT-STANDARD-INPUT*, initially with the same value as +*STANDARD-INPUT*. + +3. Assigns *STANDARD-INPUT* to a synonym stream pointing to +*CURRENT-STANDARD-INPUT*. + +This has the effect of making *CURRENT-STANDARD-INPUT* contain the +effective global value for *STANDARD-INPUT*. Thus input can be +redirected via that variable, even if *STANDARD-INPUT* itself is +shadowed by a dynamic binding." + (let ((real-stream-var (prefixed-var "REAL" stream-var)) + (current-stream-var (prefixed-var "CURRENT" stream-var))) + `(progn + ;; Save the real stream value for the future. + (defvar ,real-stream-var ,stream-var) + ;; Define a new variable for the effective stream. + ;; This can be reassigned. + (defvar ,current-stream-var ,stream-var) + ;; Assign the real binding as a synonym for the current one. + (setq ,stream-var (make-synonym-stream ',current-stream-var))))) + +(eval-when (:compile-toplevel :load-toplevel :execute) + (defun prefixed-var (prefix variable-symbol) + "(PREFIXED-VAR '*FOO* \"BAR\") => *FOO-BAR*" + (let ((basename (subseq (symbol-name variable-symbol) 1))) + (intern (format nil "*~A-~A" prefix basename) + (symbol-package variable-symbol))))) + +;;;;; Global redirection setup + +(setup-stream-indirection *standard-output*) +(setup-stream-indirection *error-output*) +(setup-stream-indirection *trace-output*) +(setup-stream-indirection *standard-input*) +(setup-stream-indirection *debug-io*) +(setup-stream-indirection *query-io*) +(setup-stream-indirection *terminal-io*) + +(defparameter *standard-output-streams* + '(*standard-output* *error-output* *trace-output*) + "The symbols naming standard output streams.") + +(defparameter *standard-input-streams* + '(*standard-input*) + "The symbols naming standard input streams.") + +(defparameter *standard-io-streams* + '(*debug-io* *query-io* *terminal-io*) + "The symbols naming standard io streams.") + +(defun globally-redirect-io-to-connection (connection) + "Set the standard I/O streams to redirect to CONNECTION. +Assigns *CURRENT-* for all standard streams." + (dolist (o *standard-output-streams*) + (set (prefixed-var "CURRENT" o) + (connection.user-output connection))) + ;; FIXME: If we redirect standard input to Emacs then we get the + ;; regular Lisp top-level trying to read from our REPL. + ;; + ;; Perhaps the ideal would be for the real top-level to run in a + ;; thread with local bindings for all the standard streams. Failing + ;; that we probably would like to inhibit it from reading while + ;; Emacs is connected. + ;; + ;; Meanwhile we just leave *standard-input* alone. + #+NIL + (dolist (i *standard-input-streams*) + (set (prefixed-var "CURRENT" i) + (connection.user-input connection))) + (dolist (io *standard-io-streams*) + (set (prefixed-var "CURRENT" io) + (connection.user-io connection)))) + +(defun revert-global-io-redirection () + "Set *CURRENT-* to *REAL-* for all standard streams." + (dolist (stream-var (append *standard-output-streams* + *standard-input-streams* + *standard-io-streams*)) + (set (prefixed-var "CURRENT" stream-var) + (symbol-value (prefixed-var "REAL" stream-var))))) + +;;;;; Global redirection hooks + +(defvar *global-stdio-connection* nil + "The connection to which standard I/O streams are globally redirected. +NIL if streams are not globally redirected.") + +(defun maybe-redirect-global-io (connection) + "Consider globally redirecting to a newly-established CONNECTION." + (when (and *globally-redirect-io* (null *global-stdio-connection*)) + (setq *global-stdio-connection* connection) + (globally-redirect-io-to-connection connection))) + +(defun update-redirection-after-close (closed-connection) + "Update redirection after a connection closes." + (when (eq *global-stdio-connection* closed-connection) + (if (and (default-connection) *globally-redirect-io*) + ;; Redirect to another connection. + (globally-redirect-io-to-connection (default-connection)) + ;; No more connections, revert to the real streams. + (progn (revert-global-io-redirection) + (setq *global-stdio-connection* nil))))) + +(add-hook *new-connection-hook* 'maybe-redirect-global-io) +(add-hook *connection-closed-hook* 'update-redirection-after-close) + +;;;;; Redirection during requests +;;; +;;; We always redirect the standard streams to Emacs while evaluating +;;; an RPC. This is done with simple dynamic bindings. (defun call-with-redirected-io (connection function) "Call FUNCTION with I/O streams redirected via CONNECTION." From lgorrie at common-lisp.net Mon Jun 21 06:13:33 2004 From: lgorrie at common-lisp.net (Luke Gorrie) Date: Sun, 20 Jun 2004 23:13:33 -0700 Subject: [slime-cvs] CVS update: slime/swank-loader.lisp Message-ID: Update of /project/slime/cvsroot/slime In directory common-lisp.net:/tmp/cvs-serv10081 Modified Files: swank-loader.lisp Log Message: (*lisp-name*): Add version number to Lispwork's fasl directory. We should do this for ACL and OpenMCL too, but for some reason my ACL 5.0 gets an error when trying to create a directory with a version number in its name, and I don't have OpenMCL to test with. Date: Sun Jun 20 23:13:33 2004 Author: lgorrie Index: slime/swank-loader.lisp diff -u slime/swank-loader.lisp:1.28 slime/swank-loader.lisp:1.29 --- slime/swank-loader.lisp:1.28 Thu Jun 17 10:41:16 2004 +++ slime/swank-loader.lisp Sun Jun 20 23:13:33 2004 @@ -44,7 +44,7 @@ #+cmu (format nil "cmu-~A" (lisp-implementation-version)) #+sbcl (format nil "sbcl-~A" (lisp-implementation-version)) #+openmcl "openmcl" - #+lispworks "lispworks" + #+lispworks (format nil "lispworks-~A" (lisp-implementation-version)) #+allegro "allegro" #+clisp (format nil "clisp-~A" (let ((s (lisp-implementation-version))) (subseq s 0 (position #\space s)))) From lgorrie at common-lisp.net Mon Jun 21 06:14:58 2004 From: lgorrie at common-lisp.net (Luke Gorrie) Date: Sun, 20 Jun 2004 23:14:58 -0700 Subject: [slime-cvs] CVS update: slime/swank-backend.lisp Message-ID: Update of /project/slime/cvsroot/slime In directory common-lisp.net:/tmp/cvs-serv12031 Modified Files: swank-backend.lisp Log Message: Removed hook mechanism (now in swank.lisp). Date: Sun Jun 20 23:14:58 2004 Author: lgorrie Index: slime/swank-backend.lisp diff -u slime/swank-backend.lisp:1.54 slime/swank-backend.lisp:1.55 --- slime/swank-backend.lisp:1.54 Sat Jun 19 22:46:24 2004 +++ slime/swank-backend.lisp Sun Jun 20 23:14:58 2004 @@ -25,10 +25,6 @@ #:position-pos #:print-output-to-string #:quit-lisp - #:*new-connection-hook* - #:*pre-reply-hook* - #:add-hook - #:run-hook )) (in-package :swank-backend) @@ -102,28 +98,6 @@ (cons `(,(first name) (,(reader (second name)) ,tmp))) (t (error "Malformed syntax in WITH-STRUCT: ~A" name)))) , at body))))) - -;;;; Hooks -;;; -;;; We use Emacs-like `add-hook' and `run-hook' utilities to support -;;; simple indirection. The interface is more CLish than the Emacs -;;; Lisp one. - -(defmacro add-hook (place function) - "Add FUNCTION to the list of values on HOOK-VARIABLE." - `(pushnew ,function ,place)) - -(defun run-hook (functions &rest arguments) - "Call each of FUNCTIONS with ARGUMENTS." - (dolist (function functions) - (apply function arguments))) - -(defvar *new-connection-hook* '(emacs-connected) - "This hook is run each time a connection is established. -The connection structure is given as the argument.") - -(defvar *pre-reply-hook* '() - "Hook run (without arguments) immediately before replying to an RPC.") ;;;; TCP server From lgorrie at common-lisp.net Mon Jun 21 06:15:07 2004 From: lgorrie at common-lisp.net (Luke Gorrie) Date: Sun, 20 Jun 2004 23:15:07 -0700 Subject: [slime-cvs] CVS update: slime/ChangeLog Message-ID: Update of /project/slime/cvsroot/slime In directory common-lisp.net:/tmp/cvs-serv13547 Modified Files: ChangeLog Log Message: Date: Sun Jun 20 23:15:07 2004 Author: lgorrie Index: slime/ChangeLog diff -u slime/ChangeLog:1.415 slime/ChangeLog:1.416 --- slime/ChangeLog:1.415 Sun Jun 20 20:16:07 2004 +++ slime/ChangeLog Sun Jun 20 23:15:07 2004 @@ -1,5 +1,24 @@ 2004-06-21 Luke Gorrie + * swank-loader.lisp (*lisp-name*): Add version number to + Lispwork's fasl directory. We should do this for ACL and OpenMCL + too, but for some reason my ACL 5.0 gets an error when trying to + create a directory with a version number in its name, and I don't + have OpenMCL to test with. + + * swank-backend.lisp, swank.lisp (add-hook, run-hook): Moved the + hook mechanism and all hooks here (from swank-backend.lisp). There + is no compelling use for backends yet, I want to pass + swank.lisp-internal data structures in the existing hooks. + (notify-backend-of-connection): Call `emacs-connected' with the + socket-io stream for its argument. Should fix previous breakage + where the connection structure was passed instead. + (*globally-redirect-io*): New configurable: when true the standard + streams are globally redirected to Emacs. That way even + e.g. SERVE-EVENT handlers will print to Emacs. Currently does not + handle standard input -- that is trickier since the Lisp's native + REPL can be trying to read from that. + * slime.el (slime-complete-maybe-restore-window-configuration): Only restore the window configuration if the completions buffer is currently visible in the window that we popped it up in. From lgorrie at common-lisp.net Mon Jun 21 06:26:13 2004 From: lgorrie at common-lisp.net (Luke Gorrie) Date: Sun, 20 Jun 2004 23:26:13 -0700 Subject: [slime-cvs] CVS update: slime/swank.lisp Message-ID: Update of /project/slime/cvsroot/slime In directory common-lisp.net:/tmp/cvs-serv1793 Modified Files: swank.lisp Log Message: Pass user-io to `emacs-connected', not socket-io. Date: Sun Jun 20 23:26:13 2004 Author: lgorrie Index: slime/swank.lisp diff -u slime/swank.lisp:1.197 slime/swank.lisp:1.198 --- slime/swank.lisp:1.197 Sun Jun 20 23:12:04 2004 +++ slime/swank.lisp Sun Jun 20 23:26:13 2004 @@ -194,7 +194,7 @@ (add-hook *new-connection-hook* 'notify-backend-of-connection) (defun notify-backend-of-connection (connection) - (emacs-connected (connection.socket-io connection))) + (emacs-connected (connection.user-io connection))) ;;;; Helper macros From lgorrie at common-lisp.net Mon Jun 21 06:27:25 2004 From: lgorrie at common-lisp.net (Luke Gorrie) Date: Sun, 20 Jun 2004 23:27:25 -0700 Subject: [slime-cvs] CVS update: slime/ChangeLog Message-ID: Update of /project/slime/cvsroot/slime In directory common-lisp.net:/tmp/cvs-serv2501 Modified Files: ChangeLog Log Message: *** empty log message *** Date: Sun Jun 20 23:27:24 2004 Author: lgorrie Index: slime/ChangeLog diff -u slime/ChangeLog:1.416 slime/ChangeLog:1.417 --- slime/ChangeLog:1.416 Sun Jun 20 23:15:07 2004 +++ slime/ChangeLog Sun Jun 20 23:27:24 2004 @@ -7,11 +7,12 @@ have OpenMCL to test with. * swank-backend.lisp, swank.lisp (add-hook, run-hook): Moved the - hook mechanism and all hooks here (from swank-backend.lisp). There - is no compelling use for backends yet, I want to pass - swank.lisp-internal data structures in the existing hooks. + hook mechanism and all hooks to swank.lisp (from + swank-backend.lisp). There is no compelling use for the hooks in + backends yet and I want to pass swank.lisp-internal data + structures in the existing hooks. (notify-backend-of-connection): Call `emacs-connected' with the - socket-io stream for its argument. Should fix previous breakage + user-io stream for its argument. Should fix previous breakage where the connection structure was passed instead. (*globally-redirect-io*): New configurable: when true the standard streams are globally redirected to Emacs. That way even From lgorrie at common-lisp.net Mon Jun 21 07:29:18 2004 From: lgorrie at common-lisp.net (Luke Gorrie) Date: Mon, 21 Jun 2004 00:29:18 -0700 Subject: [slime-cvs] CVS update: slime/swank.lisp Message-ID: Update of /project/slime/cvsroot/slime In directory common-lisp.net:/tmp/cvs-serv10704 Modified Files: swank.lisp Log Message: Doc fix. Date: Mon Jun 21 00:29:18 2004 Author: lgorrie Index: slime/swank.lisp diff -u slime/swank.lisp:1.198 slime/swank.lisp:1.199 --- slime/swank.lisp:1.198 Sun Jun 20 23:26:13 2004 +++ slime/swank.lisp Mon Jun 21 00:29:18 2004 @@ -703,11 +703,11 @@ (eval-when (:compile-toplevel :load-toplevel :execute) (defun prefixed-var (prefix variable-symbol) - "(PREFIXED-VAR '*FOO* \"BAR\") => *FOO-BAR*" + "(PREFIXED-VAR \"FOO\" '*BAR*) => *FOO-BAR*" (let ((basename (subseq (symbol-name variable-symbol) 1))) (intern (format nil "*~A-~A" prefix basename) (symbol-package variable-symbol))))) - + ;;;;; Global redirection setup (setup-stream-indirection *standard-output*) From llotw at cinci.rr.com Mon Jun 21 23:36:57 2004 From: llotw at cinci.rr.com (Beverley Mccabe) Date: Tue, 22 Jun 2004 05:36:57 +0600 Subject: [slime-cvs] Re: Any Meds You Want Prescribed Online and Shipped to Your Door. Discreetly. Message-ID: An HTML attachment was scrubbed... URL: From lgorrie at common-lisp.net Tue Jun 22 05:50:47 2004 From: lgorrie at common-lisp.net (Luke Gorrie) Date: Mon, 21 Jun 2004 22:50:47 -0700 Subject: [slime-cvs] CVS update: slime/slime.el Message-ID: Update of /project/slime/cvsroot/slime In directory common-lisp.net:/tmp/cvs-serv17904 Modified Files: slime.el Log Message: (slime-output-filter): Choose connection based on process-buffer, not current buffer. This fixes a bug where output from multiple Lisp sessions could get mixed up. (slime-kill-all-buffers): Include all *inferior-lisp*[] buffers. Split the customize settings into more subgroups. Date: Mon Jun 21 22:50:47 2004 Author: lgorrie Index: slime/slime.el diff -u slime/slime.el:1.328 slime/slime.el:1.329 --- slime/slime.el:1.328 Sun Jun 20 20:15:28 2004 +++ slime/slime.el Mon Jun 21 22:50:47 2004 @@ -138,13 +138,46 @@ "*The base URL of the SBCL manual, for documentation lookup.") -;;; Customize group +;;; Customize groups +;;; +;;;;; slime (defgroup slime nil "Interfaction with the Superior Lisp Environment." :prefix "slime-" :group 'applications) +(defcustom slime-compilation-finished-hook 'slime-maybe-list-compiler-notes + "Hook called with a list of compiler notes after a compilation." + :group 'slime + :type 'hook + :options '(slime-maybe-list-compiler-notes + slime-list-compiler-notes + slime-maybe-show-xrefs-for-notes)) + +(defcustom slime-complete-symbol-function 'slime-complete-symbol* + "Function to perform symbol completion." + :group 'slime + :type 'function + :options '(slime-complete-symbol* slime-simple-complete-symbol)) + +(defcustom slime-connected-hook nil + "List of functions to call when SLIME connects to Lisp." + :group 'slime + :type 'hook) + +(defcustom slime-startup-animation t + "Enable the startup animation." + :type '(choice (const :tag "Enable" t) (const :tag "Disable" nil)) + :group 'slime) + +;;;;; slime-mode + +(defgroup slime-mode nil + "Faces and other options for slime-mode source code buffers." + :prefix "slime-" + :group 'slime) + (defun slime-underline-color (color) "Return a legal value for the :underline face attribute based on COLOR." ;; In XEmacs the :underline attribute can only be a boolean. @@ -160,7 +193,7 @@ (:underline ,(slime-underline-color "red"))) (t (:underline t))) "Face for errors from the compiler." - :group 'slime) + :group 'slime-mode) (defface slime-warning-face `((((class color) (background light)) @@ -169,7 +202,7 @@ (:underline ,(slime-underline-color "coral"))) (t (:underline t))) "Face for warnings from the compiler." - :group 'slime) + :group 'slime-mode) (defface slime-style-warning-face `((((class color) (background light)) @@ -178,7 +211,7 @@ (:underline ,(slime-underline-color "gold"))) (t (:underline t))) "Face for style-warnings from the compiler." - :group 'slime) + :group 'slime-mode) (defface slime-note-face `((((class color) (background light)) @@ -187,7 +220,7 @@ (:underline ,(slime-underline-color "light goldenrod"))) (t (:underline t))) "Face for notes from the compiler." - :group 'slime) + :group 'slime-mode) (defun slime-face-inheritance-possible-p () "Return true if the :inherit face attribute is supported." @@ -202,60 +235,14 @@ (:background "darkolivegreen")) (t (:inverse-video t)))) "Face for compiler notes while selected." - :group 'slime) - -(defface slime-repl-prompt-face - (if (slime-face-inheritance-possible-p) - '((t (:inherit font-lock-keyword-face))) - '((((class color) (background light)) (:foreground "Purple")) - (((class color) (background dark)) (:foreground "Cyan")) - (t (:weight bold)))) - "Face for the prompt in the SLIME REPL." - :group 'slime) - -(defface slime-repl-output-face - (if (slime-face-inheritance-possible-p) - '((t (:inherit font-lock-string-face))) - '((((class color) (background light)) (:foreground "RosyBrown")) - (((class color) (background dark)) (:foreground "LightSalmon")) - (t (:slant italic)))) - "Face for Lisp output in the SLIME REPL." - :group 'slime) - -(defface slime-repl-input-face - '((t (:bold t))) - "Face for previous input in the SLIME REPL." - :group 'slime) - -(defface slime-repl-result-face - '((t ())) - "Face for the result of an evaluation in the SLIME REPL." - :group 'slime) + :group 'slime-mode) ;; inspector ;; Try '(slime-inspector-label-face ((t (:weight bold)))) ;; '(slime-inspector-topline-face ((t (:foreground "brown" :weight bold :height 1.2)))) ;; '(slime-inspector-type-face ((t (:foreground "DarkRed" :weight bold)))) -(defface slime-inspector-topline-face - '((t ())) - "Face for top line describing object." - :group 'slime) - -(defface slime-inspector-label-face - '((t (:bold t))) - "Face for labels in the inspector." - :group 'slime) - -(defface slime-inspector-value-face - '((t ())) - "Face for things which can themselves be inspected." - :group 'slime) - -(defface slime-inspector-type-face - '((t ())) - "Face for type description in inspector." - :group 'slime) +;;;;; sldb (defgroup slime-debugger nil "Backtrace options and fontification." @@ -300,30 +287,6 @@ (def-sldb-face reference "documentation reference" (:underline t)) -(defcustom slime-compilation-finished-hook 'slime-maybe-list-compiler-notes - "Hook called with a list of compiler notes after a compilation." - :group 'slime - :type 'hook - :options '(slime-maybe-list-compiler-notes - slime-list-compiler-notes - slime-maybe-show-xrefs-for-notes)) - -(defcustom slime-complete-symbol-function 'slime-complete-symbol* - "Function to perform symbol completion." - :group 'slime - :type 'function - :options '(slime-complete-symbol* slime-simple-complete-symbol)) - -(defcustom slime-connected-hook nil - "List of functions to call when SLIME connects to Lisp." - :group 'slime - :type 'hook) - -(defcustom slime-startup-animation t - "Enable the startup animation." - :type '(choice (const :tag "Enable" t) (const :tag "Disable" nil)) - :group 'slime) - ;;; Minor modes @@ -1657,6 +1620,7 @@ (when (equal slime-net-processes (list proc)) (setq slime-connection-counter 0)) (slime-with-connection-buffer () + (setq slime-buffer-connection proc) (setq slime-connection-number (incf slime-connection-counter))) (with-lexical-bindings (proc) (slime-eval-async '(swank:connection-info) nil @@ -1975,7 +1939,8 @@ (defun slime-output-filter (process string) (when (and (slime-connected-p) (plusp (length string))) - (slime-output-string string))) + (with-current-buffer (process-buffer process) + (slime-output-string string)))) (defun slime-open-stream-to-lisp (port) (let ((stream (open-network-stream "*lisp-output-stream*" @@ -2058,6 +2023,44 @@ ;; there is no prompt between output-end and input-start. ;; +(defgroup slime-repl nil + "The Read-Eval-Print Loop (*slime-repl* buffer)." + :prefix "slime-repl-" + :group 'slime) + +(defcustom slime-repl-shortcut-dispatch-char ?\, + "Character used to distinguish repl commands from lisp forms." + :type '(character) + :group 'slime-repl) + +(defface slime-repl-prompt-face + (if (slime-face-inheritance-possible-p) + '((t (:inherit font-lock-keyword-face))) + '((((class color) (background light)) (:foreground "Purple")) + (((class color) (background dark)) (:foreground "Cyan")) + (t (:weight bold)))) + "Face for the prompt in the SLIME REPL." + :group 'slime-repl) + +(defface slime-repl-output-face + (if (slime-face-inheritance-possible-p) + '((t (:inherit font-lock-string-face))) + '((((class color) (background light)) (:foreground "RosyBrown")) + (((class color) (background dark)) (:foreground "LightSalmon")) + (t (:slant italic)))) + "Face for Lisp output in the SLIME REPL." + :group 'slime-repl) + +(defface slime-repl-input-face + '((t (:bold t))) + "Face for previous input in the SLIME REPL." + :group 'slime-repl) + +(defface slime-repl-result-face + '((t ())) + "Face for the result of an evaluation in the SLIME REPL." + :group 'slime-repl) + ;; Small helper. (defun slime-make-variables-buffer-local (&rest variables) (mapcar #'make-variable-buffer-local variables)) @@ -2074,11 +2077,6 @@ (defvar slime-repl-input-end-mark) (defvar slime-repl-last-input-start-mark)) -(defcustom slime-repl-shortcut-dispatch-char ?\, - "Character used to distinguish repl commands from lisp forms." - :type '(character) - :group 'slime) - (defvar slime-repl-mode-map) (defun slime-repl-buffer (&optional create) @@ -2724,8 +2722,8 @@ "Kill all the slime related buffers. This is only used by the repl command sayoonara." (dolist (buf (buffer-list)) - (when (or (member (buffer-name buf) '("*inferior-lisp*" - slime-event-buffer-name)) + (when (or (string= (buffer-name buf) slime-event-buffer-name) + (string-match "^\\*inferior-lisp*" (buffer-name buf)) (string-match "^\\*slime-repl\\[[0-9]+\\]\\*$" (buffer-name buf)) (string-match "^\\*sldb .*\\*$" (buffer-name buf))) (kill-buffer buf)))) @@ -5700,6 +5698,31 @@ ;;; Inspector + +(defgroup slime-inspector nil + "Inspector faces." + :prefix "slime-inspector-" + :group 'slime) + +(defface slime-inspector-topline-face + '((t ())) + "Face for top line describing object." + :group 'slime-inspector) + +(defface slime-inspector-label-face + '((t (:bold t))) + "Face for labels in the inspector." + :group 'slime-inspector) + +(defface slime-inspector-value-face + '((t ())) + "Face for things which can themselves be inspected." + :group 'slime-inspector) + +(defface slime-inspector-type-face + '((t ())) + "Face for type description in inspector." + :group 'slime-inspector) (defvar slime-inspector-mark-stack '()) From lgorrie at common-lisp.net Tue Jun 22 05:52:47 2004 From: lgorrie at common-lisp.net (Luke Gorrie) Date: Mon, 21 Jun 2004 22:52:47 -0700 Subject: [slime-cvs] CVS update: slime/swank.lisp Message-ID: Update of /project/slime/cvsroot/slime In directory common-lisp.net:/tmp/cvs-serv22982 Modified Files: swank.lisp Log Message: (prefixed-var): Intern *REAL-STANDARD-INPUT* etc in the SWANK package instead of the COMMON-LISP package. Date: Mon Jun 21 22:52:47 2004 Author: lgorrie Index: slime/swank.lisp diff -u slime/swank.lisp:1.199 slime/swank.lisp:1.200 --- slime/swank.lisp:1.199 Mon Jun 21 00:29:18 2004 +++ slime/swank.lisp Mon Jun 21 22:52:47 2004 @@ -687,9 +687,9 @@ *CURRENT-STANDARD-INPUT*. This has the effect of making *CURRENT-STANDARD-INPUT* contain the -effective global value for *STANDARD-INPUT*. Thus input can be -redirected via that variable, even if *STANDARD-INPUT* itself is -shadowed by a dynamic binding." +effective global value for *STANDARD-INPUT*. This way we can assign +the effective global value even when *STANDARD-INPUT* is shadowed by a +dynamic binding." (let ((real-stream-var (prefixed-var "REAL" stream-var)) (current-stream-var (prefixed-var "CURRENT" stream-var))) `(progn @@ -703,10 +703,9 @@ (eval-when (:compile-toplevel :load-toplevel :execute) (defun prefixed-var (prefix variable-symbol) - "(PREFIXED-VAR \"FOO\" '*BAR*) => *FOO-BAR*" + "(PREFIXED-VAR \"FOO\" '*BAR*) => SWANK::*FOO-BAR*" (let ((basename (subseq (symbol-name variable-symbol) 1))) - (intern (format nil "*~A-~A" prefix basename) - (symbol-package variable-symbol))))) + (intern (format nil "*~A-~A" prefix basename) :swank)))) ;;;;; Global redirection setup From lgorrie at common-lisp.net Tue Jun 22 05:53:21 2004 From: lgorrie at common-lisp.net (Luke Gorrie) Date: Mon, 21 Jun 2004 22:53:21 -0700 Subject: [slime-cvs] CVS update: slime/ChangeLog Message-ID: Update of /project/slime/cvsroot/slime In directory common-lisp.net:/tmp/cvs-serv24391 Modified Files: ChangeLog Log Message: Date: Mon Jun 21 22:53:21 2004 Author: lgorrie Index: slime/ChangeLog diff -u slime/ChangeLog:1.417 slime/ChangeLog:1.418 --- slime/ChangeLog:1.417 Sun Jun 20 23:27:24 2004 +++ slime/ChangeLog Mon Jun 21 22:53:21 2004 @@ -1,3 +1,14 @@ +2004-06-22 Luke Gorrie + + * slime.el (slime-output-filter): Choose connection based on + process-buffer, not current buffer. This fixes a bug where output + from multiple Lisp sessions could get mixed up. + (slime-kill-all-buffers): Include all *inferior-lisp*[] buffers. + Split the customize settings into more subgroups. + + * swank.lisp (prefixed-var): Intern *REAL-STANDARD-INPUT* etc in + the SWANK package instead of the COMMON-LISP package. + 2004-06-21 Luke Gorrie * swank-loader.lisp (*lisp-name*): Add version number to From lgorrie at common-lisp.net Tue Jun 22 06:24:17 2004 From: lgorrie at common-lisp.net (Luke Gorrie) Date: Mon, 21 Jun 2004 23:24:17 -0700 Subject: [slime-cvs] CVS update: slime/swank-backend.lisp Message-ID: Update of /project/slime/cvsroot/slime In directory common-lisp.net:/tmp/cvs-serv30659 Modified Files: swank-backend.lisp Log Message: (unbound-slot-filler): New structure for representing an unbound slot in the inspector functions. Date: Mon Jun 21 23:24:17 2004 Author: lgorrie Index: slime/swank-backend.lisp diff -u slime/swank-backend.lisp:1.55 slime/swank-backend.lisp:1.56 --- slime/swank-backend.lisp:1.55 Sun Jun 20 23:14:58 2004 +++ slime/swank-backend.lisp Mon Jun 21 23:24:17 2004 @@ -25,7 +25,7 @@ #:position-pos #:print-output-to-string #:quit-lisp - )) + #:unbound-slot-filler)) (in-package :swank-backend) @@ -509,6 +509,13 @@ ;;;; Inspector + +(defstruct (unbound-slot-filler + (:print-object + (lambda (obj stream) + (print-unreadable-object (obj stream :type t))))) + "The definition of an object which serves as a placeholder in +an unbound slot for inspection purposes.") (definterface inspected-parts (object) "Return a short description and a list of (LABEL . VALUE) pairs." From lgorrie at common-lisp.net Tue Jun 22 06:24:48 2004 From: lgorrie at common-lisp.net (Luke Gorrie) Date: Mon, 21 Jun 2004 23:24:48 -0700 Subject: [slime-cvs] CVS update: slime/swank.lisp slime/swank-allegro.lisp Message-ID: Update of /project/slime/cvsroot/slime In directory common-lisp.net:/tmp/cvs-serv32448 Modified Files: swank.lisp swank-allegro.lisp Log Message: Use `unbound-slot-filler' for unbound inspector slots. Date: Mon Jun 21 23:24:48 2004 Author: lgorrie Index: slime/swank.lisp diff -u slime/swank.lisp:1.200 slime/swank.lisp:1.201 --- slime/swank.lisp:1.200 Mon Jun 21 22:52:47 2004 +++ slime/swank.lisp Mon Jun 21 23:24:48 2004 @@ -2208,6 +2208,9 @@ o) pairs)))) +(defmethod inspected-parts ((o unbound-slot-filler)) + (values "This slot is unbound" nil)) + (defslimefun inspect-in-frame (string index) (with-buffer-syntax () (reset-inspector) Index: slime/swank-allegro.lisp diff -u slime/swank-allegro.lisp:1.37 slime/swank-allegro.lisp:1.38 --- slime/swank-allegro.lisp:1.37 Fri Jun 18 12:27:37 2004 +++ slime/swank-allegro.lisp Mon Jun 21 23:24:48 2004 @@ -280,7 +280,9 @@ (mapcar (lambda (slot) (let ((name (clos:slot-definition-name slot))) (cons (princ-to-string name) - (slot-value o name)))) + (if (slot-boundp o name) + (slot-value o name) + (make-unbound-slot-filler))))) slots)))) ;;;; Multithreading From lgorrie at common-lisp.net Tue Jun 22 06:25:07 2004 From: lgorrie at common-lisp.net (Luke Gorrie) Date: Mon, 21 Jun 2004 23:25:07 -0700 Subject: [slime-cvs] CVS update: slime/ChangeLog Message-ID: Update of /project/slime/cvsroot/slime In directory common-lisp.net:/tmp/cvs-serv1607 Modified Files: ChangeLog Log Message: Date: Mon Jun 21 23:25:07 2004 Author: lgorrie Index: slime/ChangeLog diff -u slime/ChangeLog:1.418 slime/ChangeLog:1.419 --- slime/ChangeLog:1.418 Mon Jun 21 22:53:21 2004 +++ slime/ChangeLog Mon Jun 21 23:25:07 2004 @@ -1,3 +1,10 @@ +2004-06-22 Matthew Danish + + * swank-backend.lisp (unbound-slot-filler): New structure for + representing an unbound slot in the inspector functions. + + * swank.lisp, swank-allegro.lisp: Use it. + 2004-06-22 Luke Gorrie * slime.el (slime-output-filter): Choose connection based on From lgorrie at common-lisp.net Tue Jun 22 08:02:15 2004 From: lgorrie at common-lisp.net (Luke Gorrie) Date: Tue, 22 Jun 2004 01:02:15 -0700 Subject: [slime-cvs] CVS update: slime/swank.lisp slime/slime.el Message-ID: Update of /project/slime/cvsroot/slime In directory common-lisp.net:/tmp/cvs-serv3456 Modified Files: swank.lisp slime.el Log Message: Added "fuzzy completion" by Brian Downing. Date: Tue Jun 22 01:02:15 2004 Author: lgorrie Index: slime/swank.lisp diff -u slime/swank.lisp:1.201 slime/swank.lisp:1.202 --- slime/swank.lisp:1.201 Mon Jun 21 23:24:48 2004 +++ slime/swank.lisp Tue Jun 22 01:02:15 2004 @@ -1611,14 +1611,16 @@ (let ((package (carefully-find-package package-name default-package-name))) (values name package-name package internal-p)))) +(defun format-completion-result (string internal-p package-name) + (let ((prefix (cond (internal-p (format nil "~A::" package-name)) + (package-name (format nil "~A:" package-name)) + (t "")))) + (values (concatenate 'string prefix string) + (length prefix)))) + (defun format-completion-set (strings internal-p package-name) (mapcar (lambda (string) - (cond (internal-p - (format nil "~A::~A" package-name string)) - (package-name - (format nil "~A:~A" package-name string)) - (t - (format nil "~A" string)))) + (format-completion-result string internal-p package-name)) (sort strings #'string<))) (defun output-case-converter (input) @@ -1677,6 +1679,80 @@ (nconc (mapcar #'symbol-name symbols) packs)))) (format-completion-set strings internal-p package-name)))) +(defun fuzzy-find-matching-symbols (string package external) + "Return a list of symbols in PACKAGE matching STRING using the +fuzzy completion algorithm. If EXTERNAL is true, only external +symbols are returned." + (let ((completions '()) + (converter (output-case-converter string))) + (flet ((symbol-match (symbol) + (and (or (not external) + (symbol-external-p symbol package)) + (compute-highest-scoring-completion + string (funcall converter (symbol-name symbol)) #'char=)))) + (do-symbols (symbol package) + (multiple-value-bind (result score) (symbol-match symbol) + (when result + (push (list symbol score result) completions))))) + (remove-duplicates completions :key #'first))) + +(defun fuzzy-find-matching-packages (name) + "Return a list of package names matching NAME using the fuzzy +completion algorithm." + (let ((converter (output-case-converter name))) + (loop for package in (list-all-packages) + for package-name = (concatenate 'string + (funcall converter + (package-name package)) + ":") + for (result score) = (multiple-value-list + (compute-highest-scoring-completion + name package-name #'char=)) + if result collect (list package-name score result)))) + +(defun fuzzy-completion-set (string default-package-name &optional limit) + "Prepares list of completion objects, sorted by SCORE, of fuzzy +completions of STRING in DEFAULT-PACKAGE-NAME. If LIMIT is set, +only the top LIMIT results will be returned." + (declare (type simple-base-string string)) + (multiple-value-bind (name package-name package internal-p) + (parse-completion-arguments string default-package-name) + (let* ((symbols (and package + (fuzzy-find-matching-symbols name + package + (and (not internal-p) + package-name)))) + (packs (and (not package-name) + (fuzzy-find-matching-packages name))) + (converter (output-case-converter name)) + (results + (sort (mapcar + #'(lambda (result) + (destructuring-bind (symbol-or-name score chunks) result + (multiple-value-bind (name added-length) + (format-completion-result + (funcall converter + (if (symbolp symbol-or-name) + (symbol-name symbol-or-name) + symbol-or-name)) + internal-p package-name) + (list name score + (mapcar + #'(lambda (chunk) + ;; fix up chunk positions to + ;; account for possible added + ;; package identifier + (list (+ added-length (first chunk)) + (second chunk))) + chunks))))) + (nconc symbols packs)) + #'> :key #'second))) + (when (and limit + (> limit 0) + (< limit (length results))) + (setf (cdr (nthcdr (1- limit) results)) nil)) + results))) + (defslimefun completions (string default-package-name) "Return a list of completions for a symbol designator STRING. @@ -1705,6 +1781,45 @@ #'prefix-match-p))) (list completion-set (longest-common-prefix completion-set)))) +(defslimefun fuzzy-completions (string default-package-name &optional limit) + "Return an (optionally limited to LIMIT best results) list of +fuzzy completions for a symbol designator STRING. The list will +be sorted by score, most likely match first. + +The result is a list of completion objects, where a completion +object is: + (COMPLETED-STRING SCORE (&rest CHUNKS)) +where a CHUNK is a description of a matched string of characters: + (OFFSET STRING) +For example, the top result for completing \"mvb\" in a package +that uses COMMON-LISP would be something like: + (\"multiple-value-bind\" 42.391666 ((0 \"mul\") (9 \"v\") (15 \"b\"))) + +If STRING is package qualified the result list will also be +qualified. If string is non-qualified the result strings are +also not qualified and are considered relative to +DEFAULT-PACKAGE-NAME. + +Which symbols are candidates for matching depends on the symbol +designator's format. The cases are as follows: + FOO - Symbols accessible in the buffer package. + PKG:FOO - Symbols external in package PKG. + PKG::FOO - Symbols accessible in package PKG." + (fuzzy-completion-set string default-package-name limit)) + +(defslimefun fuzzy-completion-selected (original-string completion) + "This function is called by Slime when a fuzzy completion is +selected by the user. It is for future expansion to make +testing, say, a machine learning algorithm for completion scoring +easier. + +ORIGINAL-STRING is the string the user completed from, and +COMPLETION is the completion object (see docstring for +SWANK:FUZZY-COMPLETIONS) corresponding to the completion that the +user selected." + (declare (ignore original-string completion)) + nil) + (defun tokenize-symbol-designator (string) "Parse STRING as a symbol designator. Return three values: @@ -1726,6 +1841,231 @@ (declare (ignore _)) (eq status :external))) +;;; Fuzzy completion core + +(defparameter *fuzzy-recursion-soft-limit* 30 + "This is a soft limit for recursion in +RECURSIVELY-COMPUTE-MOST-COMPLETIONS. Without this limit, +completing a string such as \"ZZZZZZ\" with a symbol named +\"ZZZZZZZZZZZZZZZZZZZZZZZ\" will result in explosive recursion to +find all the ways it can match. + +Most natural language searches and symbols do not have this +problem -- this is only here as a safeguard.") + +(defun recursively-compute-most-completions + (short full test + short-index initial-full-index + chunks current-chunk current-chunk-pos + recurse-p) + "Recursively (if RECURSE-P is true) find /most/ possible ways +to fuzzily map the letters in SHORT onto FULL, with TEST being a +function to determine if two letters match. + +A chunk is a list of elements that have matched consecutively. +When consecutive matches stop, it is coerced into a string, +paired with the starting position of the chunk, and pushed onto +CHUNKS. + +Whenever a letter matches, if RECURSE-P is true, +RECURSIVELY-COMPUTE-MOST-COMPLETIONS calls itself with a position +one index ahead, to find other possibly higher scoring +possibilities. If there are less than +*FUZZY-RECURSION-SOFT-LIMIT* results in *ALL-CHUNKS* currently, +this call will also recurse. + +Once a word has been completely matched, the chunks are pushed +onto the special variable *ALL-CHUNKS* and the function returns." + (declare (special *all-chunks*)) + (flet ((short-cur () + "Returns the next letter from the abbreviation, or NIL + if all have been used." + (if (= short-index (length short)) + nil + (aref short short-index))) + (add-to-chunk (char pos) + "Adds the CHAR at POS in FULL to the current chunk, + marking the start position if it is empty." + (unless current-chunk + (setf current-chunk-pos pos)) + (push char current-chunk)) + (collect-chunk () + "Collects the current chunk to CHUNKS and prepares for + a new chunk." + (when current-chunk + (push (list current-chunk-pos + (coerce (reverse current-chunk) 'string)) chunks) + (setf current-chunk nil + current-chunk-pos nil)))) + ;; If there's an outstanding chunk coming in collect it. Since + ;; we're recursively called on skipping an input character, the + ;; chunk can't possibly continue on. + (when current-chunk (collect-chunk)) + (do ((pos initial-full-index (1+ pos))) + ((= pos (length full))) + (let ((cur-char (aref full pos))) + (if (and (short-cur) + (funcall test cur-char (short-cur))) + (progn + (when recurse-p + ;; Try other possibilities, limiting insanely deep + ;; recursion somewhat. + (recursively-compute-most-completions + short full test short-index (1+ pos) + chunks current-chunk current-chunk-pos + (not (> (length *all-chunks*) + *fuzzy-recursion-soft-limit*)))) + (incf short-index) + (add-to-chunk cur-char pos)) + (collect-chunk)))) + (collect-chunk) + ;; If we've exhausted the short characters we have a match. + (if (short-cur) + nil + (let ((rev-chunks (reverse chunks))) + (push rev-chunks *all-chunks*) + rev-chunks)))) + +(defun compute-most-completions (short full test) + "Finds most possible ways to complete FULL with the letters in SHORT. +Calls RECURSIVELY-COMPUTE-MOST-COMPLETIONS recursively. Returns +a list of (&rest CHUNKS), where each CHUNKS is a description of +how a completion matches." + (let ((*all-chunks* nil)) + (declare (special *all-chunks*)) + (recursively-compute-most-completions short full test 0 0 nil nil nil t) + *all-chunks*)) + +(defun compute-completion (short full test) + "Finds the first way to complete FULL with the letters in SHORT. +Calls RECURSIVELY-COMPUTE-MOST-COMPLETIONS non-recursively. +Returns a list of one (&rest CHUNKS), where CHUNKS is a +description of how the completion matched." + (let ((*all-chunks* nil)) + (declare (special *all-chunks*)) + (recursively-compute-most-completions short full test 0 0 nil nil nil nil) + *all-chunks*)) + +(defparameter *fuzzy-completion-symbol-prefixes* "*+-%&?<" + "Letters that are likely to be at the beginning of a symbol. +Letters found after one of these prefixes will be scored as if +they were at the beginning of ths symbol.") +(defparameter *fuzzy-completion-symbol-suffixes* "*+->" + "Letters that are likely to be at the end of a symbol. +Letters found before one of these suffixes will be scored as if +they were at the end of the symbol.") +(defparameter *fuzzy-completion-word-separators* "-/." + "Letters that separate different words in symbols. Letters +after one of these symbols will be scores more highly than other +letters.") + +(defun score-completion (completion short full) + "Scores the completion chunks COMPLETION as a completion from +the abbreviation SHORT to the full string FULL. COMPLETION is a +list like: + ((0 \"mul\") (9 \"v\") (15 \"b\")) +Which, if SHORT were \"mulvb\" and full were \"multiple-value-bind\", +would indicate that it completed as such (completed letters +capitalized): + MULtiple-Value-Bind + +Letters are given scores based on their position in the string. +Letters at the beginning of a string or after a prefix letter at +the beginning of a string are scored highest. Letters after a +word separator such as #\- are scored next highest. Letters at +the end of a string or before a suffix letter at the end of a +string are scored medium, and letters anywhere else are scored +low. + +If a letter is directly after another matched letter, and its +intrinsic value in that position is less than a percentage of the +previous letter's value, it will use that percentage instead. + +Finally, a small scaling factor is applied to favor shorter +matches, all other things being equal." + (flet ((score-chunk (chunk) + (let ((initial-pos (first chunk)) + (str (second chunk))) + (labels ((at-beginning-p (pos) + (= pos 0)) + (after-prefix-p (pos) + (and (= pos 1) + (find (aref full 0) + *fuzzy-completion-symbol-prefixes*))) + (word-separator-p (pos) + (find (aref full pos) + *fuzzy-completion-word-separators*)) + (after-word-separator-p (pos) + (find (aref full (1- pos)) + *fuzzy-completion-word-separators*)) + (at-end-p (pos) + (= pos (1- (length full)))) + (before-suffix-p (pos) + (and (= pos (- (length full) 2)) + (find (aref full (1- (length full))) + *fuzzy-completion-symbol-suffixes*))) + (score-or-percentage-of-previous + (base-score pos chunk-pos) + (if (zerop chunk-pos) + base-score + (max base-score + (* (score-char (1- pos) (1- chunk-pos)) + 0.85)))) + (score-char (pos chunk-pos) + (score-or-percentage-of-previous + (cond ((at-beginning-p pos) 10) + ((after-prefix-p pos) 10) + ((word-separator-p pos) 1) + ((after-word-separator-p pos) 8) + ((at-end-p pos) 6) + ((before-suffix-p pos) 6) + (t 1)) + pos chunk-pos))) + (loop for chunk-pos below (length str) + for pos from initial-pos + summing (score-char pos chunk-pos)))))) + (let* ((chunk-scores (mapcar #'score-chunk completion)) + (length-score + (/ 10 (coerce (1+ (- (length full) (length short))) + 'single-float)))) + (values + (+ (apply #'+ chunk-scores) length-score) + (list (mapcar #'list chunk-scores completion) length-score))))) + +(defun compute-highest-scoring-completion (short full test) + "Finds the highest scoring way to complete the abbreviation +SHORT onto the string FULL, using TEST as a equality function for +letters. Returns two values: The first being the completion +chunks of the high scorer, and the second being the score." + (let* ((scored-results + (mapcar #'(lambda (result) + (cons (score-completion result short full) result)) + (compute-most-completions short full test))) + (winner (first (sort scored-results #'> :key #'first)))) + (values (rest winner) (first winner)))) + +(defun highlight-completion (completion full) + "Given a chunk definition COMPLETION and the string FULL, +HIGHLIGHT-COMPLETION will create a string that demonstrates where +the completion matched in the string. Matches will be +capitalized, while the rest of the string will be lower-case." + (let ((highlit (string-downcase full))) + (dolist (chunk completion) + (setf highlit (string-upcase highlit + :start (first chunk) + :end (+ (first chunk) + (length (second chunk)))))) + highlit)) + +(defun format-fuzzy-completions (winners) + "Given a list of completion objects such as on returned by +FUZZY-COMPLETIONS, format the list into user-readable output." + (let ((max-len + (loop for winner in winners maximizing (length (first winner))))) + (loop for (sym score result) in winners do + (format t "~&~VA score ~8,2F ~A" + max-len (highlight-completion result sym) score result)))) + ;;;;; Subword-word matching Index: slime/slime.el diff -u slime/slime.el:1.329 slime/slime.el:1.330 --- slime/slime.el:1.329 Mon Jun 21 22:50:47 2004 +++ slime/slime.el Tue Jun 22 01:02:15 2004 @@ -311,6 +311,7 @@ Programming aids: \\[slime-complete-symbol] - Complete the Lisp symbol at point. (Also M-TAB.) +\\[slime-fuzzy-complete-symbol] - Fuzzily completes text at point to a Lisp symbol. \\[slime-macroexpand-1] - Macroexpand once. \\[slime-macroexpand-all] - Macroexpand all. @@ -441,6 +442,7 @@ ;; Editing/navigating ("\M-\C-i" slime-complete-symbol :inferior t) ("\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) ("\M-," slime-pop-find-definition-stack :inferior t :sldb t) ("\C-q" slime-close-parens-at-point :prefixed t :inferior t) @@ -4039,6 +4041,337 @@ (slime-buffer-package))))) +;;; Fuzzy completion + +(defvar slime-fuzzy-completion-target-buffer nil + "The buffer that is the target of the completion activities.") +(defvar slime-fuzzy-completion-window-configuration nil + "The saved window configuration before the fuzzy completion +buffer popped up.") +(defvar slime-fuzzy-completion-start nil + "The beginning of the completion slot in the target buffer.") +(defvar slime-fuzzy-completion-end nil + "The end of the completion slot in the target buffer.") +(defvar slime-fuzzy-completion-original-text nil + "The original text that was in the completion slot in the +target buffer. This is what is put back if completion is +aborted.") +(defvar slime-fuzzy-completion-current-text nil + "The text that is currently in the completion slot in the +target buffer. If this ever doesn't match, the target buffer has +been modified and we abort without touching it.") +(defvar slime-fuzzy-completion-first nil + "The position of the first completion in the completions buffer. +The descriptive text and headers are above this.") +(defvar slime-fuzzy-completion-current-completion nil + "The current completion object. If this is the same before and +after point moves in the completions buffer, the text is not +replaced in the target for efficiency.") + +(define-derived-mode slime-fuzzy-mode + fundamental-mode "Fuzzy Completions" + "Major mode for presenting fuzzy completion results. + +\\ +\\{slime-fuzzy-map}" + (use-local-map slime-fuzzy-map)) + +(defvar slime-fuzzy-map + (let* ((map (make-sparse-keymap))) + + (define-key map "q" 'slime-fuzzy-completion-abort) + (define-key map "\r" 'slime-fuzzy-completion-select) + + (define-key map "n" 'slime-fuzzy-completion-next) + (define-key map "\M-n" 'slime-fuzzy-completion-next) + + (define-key map "p" 'slime-fuzzy-completion-prev) + (define-key map "\M-p" 'slime-fuzzy-completion-prev) + + (define-key map "\d" 'scroll-down) + (define-key map " " 'scroll-up) + + (define-key map [mouse-2] 'slime-fuzzy-completion-click) + + map) + "Keymap for slime-fuzzy-mode.") + +(defun slime-fuzzy-completions (prefix &optional default-package) + "Get the list of sorted completion objects from completing +`prefix' in `package' from the connected Lisp." + (let ((prefix (etypecase prefix + (symbol (symbol-name prefix)) + (string prefix)))) + (slime-eval `(swank:fuzzy-completions ,prefix + ,(or default-package + (slime-find-buffer-package) + (slime-buffer-package)))))) + +(defun slime-fuzzy-completion-selected (prefix completion) + "Tell the connected Lisp that the user selected completion +`completion' as the completion for `prefix'." + (let ((no-properties (copy-sequence prefix))) + (set-text-properties 0 (length no-properties) nil no-properties) + (slime-eval `(swank:fuzzy-completion-selected ,no-properties + ',completion)))) + +(defun* slime-fuzzy-complete-symbol () + "Fuzzily completes the abbreviation at point into a symbol." + (interactive) + (when (save-excursion (re-search-backward "\"[^ \t\n]+\\=" nil t)) + (return-from slime-fuzzy-complete-symbol + (comint-dynamic-complete-as-filename))) + (let* ((end (move-marker (make-marker) (slime-symbol-end-pos))) + (beg (move-marker (make-marker) (slime-symbol-start-pos))) + (prefix (buffer-substring-no-properties beg end)) + (completion-set (slime-fuzzy-completions prefix))) + (if (null completion-set) + (progn (slime-minibuffer-respecting-message + "Can't find completion for \"%s\"" prefix) + (ding) + (slime-complete-restore-window-configuration)) + (goto-char end) + (cond ((= (length completion-set) 1) + (insert-and-inherit (caar completion-set)) + (delete-region beg end) + (goto-char (+ beg (length (caar completion-set)))) + (slime-minibuffer-respecting-message "Sole completion")) + ;; Incomplete + (t + (slime-minibuffer-respecting-message "Complete but not unique") + (slime-fuzzy-completion-choices-buffer completion-set beg end))) + ))) + + +(defun get-slime-fuzzy-buffer () + (get-buffer-create "*Fuzzy Completions*")) + +(defvar slime-fuzzy-explanation + "Click on a completion to select it. +In this buffer, type n and p to navigate between completions. +Type RET to select the completion near point. Type q to abort. +\n" + "The explanation that gets inserted at the beginning of the +*Fuzzy Completions* buffer.") + +(defun slime-fuzzy-insert-completion-choice (completion max-length) + "Inserts the completion object `completion' as a formatted +completion choice into the current buffer, and mark it with the +proper text properties." + (let ((start (point)) + (symbol (first completion)) + (score (second completion)) + (chunks (third completion))) + (insert symbol) + (let ((end (point))) + (dolist (chunk chunks) + (put-text-property (+ start (first chunk)) + (+ start (first chunk) + (length (second chunk))) + 'face 'bold)) + (put-text-property start (point) 'mouse-face 'highlight) + (dotimes (i (- max-length (- end start))) + (insert " ")) + (insert (format " %8.2f" score)) + (insert "\n") + (put-text-property start (point) 'completion completion)))) + +(defun slime-fuzzy-completion-click (event) + "Handle a mouse-2 click on a completion choice as if point were +on the completion choice and the slime-fuzzy-completion-select +command was run." + (interactive "e") + (save-excursion + (with-current-buffer (window-buffer (posn-window (event-end event))) + (save-excursion + (goto-char (posn-point (event-end event))) + (when (get-text-property (point) 'mouse-face) + (slime-fuzzy-completion-insert-from-point) + (slime-fuzzy-completion-select)))))) + +(defun slime-fuzzy-completion-insert (text) + "Inserts `text' into the target buffer in the completion slot. +If the buffer has been modified in the meantime, abort the +completion process. Otherwise, update all completion variables +so that the new text is present." + (with-current-buffer slime-fuzzy-completion-target-buffer + (when (not (string-equal slime-fuzzy-completion-current + (buffer-substring slime-fuzzy-completion-start + slime-fuzzy-completion-end))) + (slime-fuzzy-completion-done) + ;; Not an error, we may be in the post-command-hook. + (beep) + (message "Target buffer has been modified!")) + (goto-char slime-fuzzy-completion-end) + (insert-and-inherit text) + (delete-region slime-fuzzy-completion-start slime-fuzzy-completion-end) + (setq slime-fuzzy-completion-end (+ slime-fuzzy-completion-start + (length text))) + (setq slime-fuzzy-completion-current text) + (goto-char slime-fuzzy-completion-end))) + +(defun slime-fuzzy-completion-choices-buffer (completions start end) + "Creates (if neccessary), populates, and pops up the *Fuzzy +Completions* buffer with the completions from `completions' and +the completion slot in the current buffer bounded by `start' and +`end'. This saves the window configuration before popping the +buffer so that it can possibly be restored when the user is +done." + (remove-hook 'window-configuration-change-hook + 'slime-fuzzy-completion-window-configuration-change) + (setq slime-fuzzy-completion-start start) + (setq slime-fuzzy-completion-end end) + (setq slime-fuzzy-completion-original-text (buffer-substring start end)) + (setq slime-fuzzy-completion-current slime-fuzzy-completion-original-text) + (setq slime-fuzzy-completion-target-buffer (current-buffer)) + (set-buffer (get-slime-fuzzy-buffer)) + (setq buffer-read-only nil) + (erase-buffer) + (slime-fuzzy-mode) + (insert slime-fuzzy-explanation) + (let ((max-length 12)) + (dolist (completion completions) + (setf max-length (max max-length (length (first completion))))) + (insert "Completion:") + (dotimes (i (- max-length 10)) (insert " ")) + (insert "Score:\n") + (dotimes (i max-length) (insert "-")) + (insert " --------\n") + (setq slime-fuzzy-completion-first (point)) + (dolist (completion completions) + (slime-fuzzy-insert-completion-choice completion max-length)) + (setq buffer-read-only t)) + (setq slime-fuzzy-completion-current-completion + (caar completions)) + (slime-fuzzy-completion-insert (caar completions)) + (goto-char slime-fuzzy-completion-first) + (slime-fuzzy-completion-save-window-configuration) + (pop-to-buffer (current-buffer)) + (make-local-variable 'post-command-hook) + (add-hook 'post-command-hook + 'slime-fuzzy-completion-post-command-hook)) + +(defun slime-fuzzy-completion-insert-from-point () + "Inserts the completion that is under point in the completions +buffer into the target buffer. If the completion in question had +already been inserted, it does nothing." + (with-current-buffer (get-slime-fuzzy-buffer) + (let ((current-completion (get-text-property (point) 'completion))) + (when (and current-completion + (not (eq slime-fuzzy-completion-current-completion + current-completion))) + (slime-fuzzy-completion-insert + (first (get-text-property (point) 'completion))) + (setq slime-fuzzy-completion-current-completion + current-completion))))) + +(defun slime-fuzzy-completion-post-command-hook () + "The post-command-hook for the *Fuzzy Completions* buffer. +This makes sure the completion slot in the target buffer matches +the completion that point is on in the completions buffer." + (condition-case err + (when slime-fuzzy-completion-target-buffer + (slime-fuzzy-completion-insert-from-point)) + (error + ;; Because this is called on the post-command-hook, we mustn't let + ;; errors propagate. + (message "Error in slime-fuzzy-completion-post-command-hook: %S" err)))) + +(defun slime-fuzzy-completion-next () + "Moves point directly to the next completion in the completions +buffer." + (interactive) + (goto-char + (next-single-char-property-change (point) 'completion))) + +(defun slime-fuzzy-completion-prev () + "Moves point directly to the previous completion in the +completions buffer." + (interactive) + (goto-char (previous-single-char-property-change + (point) 'completion + nil slime-fuzzy-completion-first))) + +(defun slime-fuzzy-completion-abort () + "Aborts the completion process, setting the completions slot in +the target buffer back to its original contents." + (interactive) + (when slime-fuzzy-completion-target-buffer + (slime-fuzzy-completion-insert slime-fuzzy-completion-original-text) + (slime-fuzzy-completion-done))) + +(defun slime-fuzzy-completion-select () + "Selects the current completion, making sure that it is inserted +into the target buffer. This tells the connected Lisp what completion +was selected." + (interactive) + (when slime-fuzzy-completion-target-buffer + (with-current-buffer (get-slime-fuzzy-buffer) + (let ((completion (get-text-property (point) 'completion))) + (when completion + (slime-fuzzy-completion-insert (first completion)) + (slime-fuzzy-completion-selected slime-fuzzy-completion-original-text + completion) + (slime-fuzzy-completion-done)))))) + +(defun slime-fuzzy-completion-done () + "Cleans up after the completion process. This removes all hooks, +and attempts to restore the window configuration. If this fails, +it just burys the completions buffer and leaves the window +configuration alone." + (set-buffer slime-fuzzy-completion-target-buffer) + (remove-hook 'post-command-hook + 'slime-fuzzy-completion-post-command-hook) + (if (slime-fuzzy-completion-maybe-restore-window-configuration) + (bury-buffer (get-slime-fuzzy-buffer)) + ;; We couldn't restore the windows, so just bury the + ;; fuzzy completions buffer and let something else fill + ;; it in. + (pop-to-buffer (get-slime-fuzzy-buffer)) + (bury-buffer)) + (pop-to-buffer slime-fuzzy-completion-target-buffer) + (goto-char slime-fuzzy-completion-end) + (setq slime-fuzzy-completion-target-buffer nil)) + +(defun slime-fuzzy-completion-save-window-configuration () + "Saves the current window configuration, and sets up for the +saved configuration to be nullified if the user changes the +window configuration further. Adding the nullification routine +to window-configuration-change-hook is delayed so that the +windows stabalize before we start listening on the hook." + (setq slime-fuzzy-completion-window-configuration + (current-window-configuration)) + (setq slime-fuzzy-completion-window-configuration-change-count 0) + (run-with-timer + 0.5 nil 'slime-fuzzy-completion-window-configuration-change-add-hook)) + +(defun slime-fuzzy-completion-maybe-restore-window-configuration () + "Restores the saved window configuration if it has not been +nullified." + (remove-hook 'window-configuration-change-hook + 'slime-fuzzy-completion-window-configuration-change) + (if (not slime-fuzzy-completion-window-configuration) + nil + (set-window-configuration slime-fuzzy-completion-window-configuration) + (setq slime-fuzzy-completion-window-configuration nil) + t)) + +(defun slime-fuzzy-completion-window-configuration-change-add-hook () + "Sets up slime-fuzzy-completion-window-configuration-change on +window-configuration-change-hook." + (remove-hook 'post-command-hook + 'slime-fuzzy-completion-window-configuration-change-add-hook) + (add-hook 'window-configuration-change-hook + 'slime-fuzzy-completion-window-configuration-change)) + +(defun slime-fuzzy-completion-window-configuration-change () + "Called on window-configuration-change-hook. Since the window +configuration was changed, we nullify our saved configuration." + (remove-hook 'window-configuration-change-hook + 'slime-fuzzy-completion-window-configuration-change) + (setq slime-fuzzy-completion-window-configuration nil)) + + ;;; Interpreting Elisp symbols as CL symbols (package qualifiers) (defun slime-cl-symbol-name (symbol) @@ -6080,7 +6413,9 @@ (fill-paragraph nil) (let ((start (progn (unless (and (zerop (current-column)) (eq ?\( (char-after))) - (beginning-of-defun)) + (if slime-repl-input-start-mark + (slime-repl-beginning-of-defun) + (beginning-of-defun))) (point))) (end (ignore-errors (end-of-defun) (point)))) (unless end From lgorrie at common-lisp.net Tue Jun 22 08:02:45 2004 From: lgorrie at common-lisp.net (Luke Gorrie) Date: Tue, 22 Jun 2004 01:02:45 -0700 Subject: [slime-cvs] CVS update: slime/ChangeLog Message-ID: Update of /project/slime/cvsroot/slime In directory common-lisp.net:/tmp/cvs-serv3902 Modified Files: ChangeLog Log Message: Date: Tue Jun 22 01:02:45 2004 Author: lgorrie Index: slime/ChangeLog diff -u slime/ChangeLog:1.419 slime/ChangeLog:1.420 --- slime/ChangeLog:1.419 Mon Jun 21 23:25:07 2004 +++ slime/ChangeLog Tue Jun 22 01:02:45 2004 @@ -1,3 +1,9 @@ +2004-06-22 Brian Downing + + * slime.el, swank.lisp: Added "fuzzy completion." + [I'm hacking the elisp end of this at the moment. Checked in now + so that I can use CVS on it. -luke] + 2004-06-22 Matthew Danish * swank-backend.lisp (unbound-slot-filler): New structure for From lgorrie at common-lisp.net Tue Jun 22 08:05:44 2004 From: lgorrie at common-lisp.net (Luke Gorrie) Date: Tue, 22 Jun 2004 01:05:44 -0700 Subject: [slime-cvs] CVS update: slime/slime.el Message-ID: Update of /project/slime/cvsroot/slime In directory common-lisp.net:/tmp/cvs-serv9454 Modified Files: slime.el Log Message: Use a shorter prefix: `slime-fuzzy-' instead of `slime-fuzzy-completion-' Date: Tue Jun 22 01:05:43 2004 Author: lgorrie Index: slime/slime.el diff -u slime/slime.el:1.330 slime/slime.el:1.331 --- slime/slime.el:1.330 Tue Jun 22 01:02:15 2004 +++ slime/slime.el Tue Jun 22 01:05:43 2004 @@ -4043,27 +4043,27 @@ ;;; Fuzzy completion -(defvar slime-fuzzy-completion-target-buffer nil +(defvar slime-fuzzy-target-buffer nil "The buffer that is the target of the completion activities.") -(defvar slime-fuzzy-completion-window-configuration nil +(defvar slime-fuzzy-window-configuration nil "The saved window configuration before the fuzzy completion buffer popped up.") -(defvar slime-fuzzy-completion-start nil +(defvar slime-fuzzy-start nil "The beginning of the completion slot in the target buffer.") -(defvar slime-fuzzy-completion-end nil +(defvar slime-fuzzy-end nil "The end of the completion slot in the target buffer.") -(defvar slime-fuzzy-completion-original-text nil +(defvar slime-fuzzy-original-text nil "The original text that was in the completion slot in the target buffer. This is what is put back if completion is aborted.") -(defvar slime-fuzzy-completion-current-text nil +(defvar slime-fuzzy-current-text nil "The text that is currently in the completion slot in the target buffer. If this ever doesn't match, the target buffer has been modified and we abort without touching it.") -(defvar slime-fuzzy-completion-first nil +(defvar slime-fuzzy-first nil "The position of the first completion in the completions buffer. The descriptive text and headers are above this.") -(defvar slime-fuzzy-completion-current-completion nil +(defvar slime-fuzzy-current-completion nil "The current completion object. If this is the same before and after point moves in the completions buffer, the text is not replaced in the target for efficiency.") @@ -4079,19 +4079,19 @@ (defvar slime-fuzzy-map (let* ((map (make-sparse-keymap))) - (define-key map "q" 'slime-fuzzy-completion-abort) - (define-key map "\r" 'slime-fuzzy-completion-select) + (define-key map "q" 'slime-fuzzy-abort) + (define-key map "\r" 'slime-fuzzy-select) - (define-key map "n" 'slime-fuzzy-completion-next) - (define-key map "\M-n" 'slime-fuzzy-completion-next) + (define-key map "n" 'slime-fuzzy-next) + (define-key map "\M-n" 'slime-fuzzy-next) - (define-key map "p" 'slime-fuzzy-completion-prev) - (define-key map "\M-p" 'slime-fuzzy-completion-prev) + (define-key map "p" 'slime-fuzzy-prev) + (define-key map "\M-p" 'slime-fuzzy-prev) (define-key map "\d" 'scroll-down) (define-key map " " 'scroll-up) - (define-key map [mouse-2] 'slime-fuzzy-completion-click) + (define-key map [mouse-2] 'slime-fuzzy-click) map) "Keymap for slime-fuzzy-mode.") @@ -4107,7 +4107,7 @@ (slime-find-buffer-package) (slime-buffer-package)))))) -(defun slime-fuzzy-completion-selected (prefix completion) +(defun slime-fuzzy-selected (prefix completion) "Tell the connected Lisp that the user selected completion `completion' as the completion for `prefix'." (let ((no-properties (copy-sequence prefix))) @@ -4139,7 +4139,7 @@ ;; Incomplete (t (slime-minibuffer-respecting-message "Complete but not unique") - (slime-fuzzy-completion-choices-buffer completion-set beg end))) + (slime-fuzzy-choices-buffer completion-set beg end))) ))) @@ -4176,9 +4176,9 @@ (insert "\n") (put-text-property start (point) 'completion completion)))) -(defun slime-fuzzy-completion-click (event) +(defun slime-fuzzy-click (event) "Handle a mouse-2 click on a completion choice as if point were -on the completion choice and the slime-fuzzy-completion-select +on the completion choice and the slime-fuzzy-select command was run." (interactive "e") (save-excursion @@ -4186,31 +4186,31 @@ (save-excursion (goto-char (posn-point (event-end event))) (when (get-text-property (point) 'mouse-face) - (slime-fuzzy-completion-insert-from-point) - (slime-fuzzy-completion-select)))))) + (slime-fuzzy-insert-from-point) + (slime-fuzzy-select)))))) -(defun slime-fuzzy-completion-insert (text) +(defun slime-fuzzy-insert (text) "Inserts `text' into the target buffer in the completion slot. If the buffer has been modified in the meantime, abort the completion process. Otherwise, update all completion variables so that the new text is present." - (with-current-buffer slime-fuzzy-completion-target-buffer - (when (not (string-equal slime-fuzzy-completion-current - (buffer-substring slime-fuzzy-completion-start - slime-fuzzy-completion-end))) - (slime-fuzzy-completion-done) + (with-current-buffer slime-fuzzy-target-buffer + (when (not (string-equal slime-fuzzy-current + (buffer-substring slime-fuzzy-start + slime-fuzzy-end))) + (slime-fuzzy-done) ;; Not an error, we may be in the post-command-hook. (beep) (message "Target buffer has been modified!")) - (goto-char slime-fuzzy-completion-end) + (goto-char slime-fuzzy-end) (insert-and-inherit text) - (delete-region slime-fuzzy-completion-start slime-fuzzy-completion-end) - (setq slime-fuzzy-completion-end (+ slime-fuzzy-completion-start + (delete-region slime-fuzzy-start slime-fuzzy-end) + (setq slime-fuzzy-end (+ slime-fuzzy-start (length text))) - (setq slime-fuzzy-completion-current text) - (goto-char slime-fuzzy-completion-end))) + (setq slime-fuzzy-current text) + (goto-char slime-fuzzy-end))) -(defun slime-fuzzy-completion-choices-buffer (completions start end) +(defun slime-fuzzy-choices-buffer (completions start end) "Creates (if neccessary), populates, and pops up the *Fuzzy Completions* buffer with the completions from `completions' and the completion slot in the current buffer bounded by `start' and @@ -4218,12 +4218,12 @@ buffer so that it can possibly be restored when the user is done." (remove-hook 'window-configuration-change-hook - 'slime-fuzzy-completion-window-configuration-change) - (setq slime-fuzzy-completion-start start) - (setq slime-fuzzy-completion-end end) - (setq slime-fuzzy-completion-original-text (buffer-substring start end)) - (setq slime-fuzzy-completion-current slime-fuzzy-completion-original-text) - (setq slime-fuzzy-completion-target-buffer (current-buffer)) + 'slime-fuzzy-window-configuration-change) + (setq slime-fuzzy-start start) + (setq slime-fuzzy-end end) + (setq slime-fuzzy-original-text (buffer-substring start end)) + (setq slime-fuzzy-current slime-fuzzy-original-text) + (setq slime-fuzzy-target-buffer (current-buffer)) (set-buffer (get-slime-fuzzy-buffer)) (setq buffer-read-only nil) (erase-buffer) @@ -4237,139 +4237,139 @@ (insert "Score:\n") (dotimes (i max-length) (insert "-")) (insert " --------\n") - (setq slime-fuzzy-completion-first (point)) + (setq slime-fuzzy-first (point)) (dolist (completion completions) (slime-fuzzy-insert-completion-choice completion max-length)) (setq buffer-read-only t)) - (setq slime-fuzzy-completion-current-completion + (setq slime-fuzzy-current-completion (caar completions)) - (slime-fuzzy-completion-insert (caar completions)) - (goto-char slime-fuzzy-completion-first) - (slime-fuzzy-completion-save-window-configuration) + (slime-fuzzy-insert (caar completions)) + (goto-char slime-fuzzy-first) + (slime-fuzzy-save-window-configuration) (pop-to-buffer (current-buffer)) (make-local-variable 'post-command-hook) (add-hook 'post-command-hook - 'slime-fuzzy-completion-post-command-hook)) + 'slime-fuzzy-post-command-hook)) -(defun slime-fuzzy-completion-insert-from-point () +(defun slime-fuzzy-insert-from-point () "Inserts the completion that is under point in the completions buffer into the target buffer. If the completion in question had already been inserted, it does nothing." (with-current-buffer (get-slime-fuzzy-buffer) (let ((current-completion (get-text-property (point) 'completion))) (when (and current-completion - (not (eq slime-fuzzy-completion-current-completion + (not (eq slime-fuzzy-current-completion current-completion))) - (slime-fuzzy-completion-insert + (slime-fuzzy-insert (first (get-text-property (point) 'completion))) - (setq slime-fuzzy-completion-current-completion + (setq slime-fuzzy-current-completion current-completion))))) -(defun slime-fuzzy-completion-post-command-hook () +(defun slime-fuzzy-post-command-hook () "The post-command-hook for the *Fuzzy Completions* buffer. This makes sure the completion slot in the target buffer matches the completion that point is on in the completions buffer." (condition-case err - (when slime-fuzzy-completion-target-buffer - (slime-fuzzy-completion-insert-from-point)) + (when slime-fuzzy-target-buffer + (slime-fuzzy-insert-from-point)) (error ;; Because this is called on the post-command-hook, we mustn't let ;; errors propagate. - (message "Error in slime-fuzzy-completion-post-command-hook: %S" err)))) + (message "Error in slime-fuzzy-post-command-hook: %S" err)))) -(defun slime-fuzzy-completion-next () +(defun slime-fuzzy-next () "Moves point directly to the next completion in the completions buffer." (interactive) (goto-char (next-single-char-property-change (point) 'completion))) -(defun slime-fuzzy-completion-prev () +(defun slime-fuzzy-prev () "Moves point directly to the previous completion in the completions buffer." (interactive) (goto-char (previous-single-char-property-change (point) 'completion - nil slime-fuzzy-completion-first))) + nil slime-fuzzy-first))) -(defun slime-fuzzy-completion-abort () +(defun slime-fuzzy-abort () "Aborts the completion process, setting the completions slot in the target buffer back to its original contents." (interactive) - (when slime-fuzzy-completion-target-buffer - (slime-fuzzy-completion-insert slime-fuzzy-completion-original-text) - (slime-fuzzy-completion-done))) + (when slime-fuzzy-target-buffer + (slime-fuzzy-insert slime-fuzzy-original-text) + (slime-fuzzy-done))) -(defun slime-fuzzy-completion-select () +(defun slime-fuzzy-select () "Selects the current completion, making sure that it is inserted into the target buffer. This tells the connected Lisp what completion was selected." (interactive) - (when slime-fuzzy-completion-target-buffer + (when slime-fuzzy-target-buffer (with-current-buffer (get-slime-fuzzy-buffer) (let ((completion (get-text-property (point) 'completion))) (when completion - (slime-fuzzy-completion-insert (first completion)) - (slime-fuzzy-completion-selected slime-fuzzy-completion-original-text + (slime-fuzzy-insert (first completion)) + (slime-fuzzy-selected slime-fuzzy-original-text completion) - (slime-fuzzy-completion-done)))))) + (slime-fuzzy-done)))))) -(defun slime-fuzzy-completion-done () +(defun slime-fuzzy-done () "Cleans up after the completion process. This removes all hooks, and attempts to restore the window configuration. If this fails, it just burys the completions buffer and leaves the window configuration alone." - (set-buffer slime-fuzzy-completion-target-buffer) + (set-buffer slime-fuzzy-target-buffer) (remove-hook 'post-command-hook - 'slime-fuzzy-completion-post-command-hook) - (if (slime-fuzzy-completion-maybe-restore-window-configuration) + 'slime-fuzzy-post-command-hook) + (if (slime-fuzzy-maybe-restore-window-configuration) (bury-buffer (get-slime-fuzzy-buffer)) ;; We couldn't restore the windows, so just bury the ;; fuzzy completions buffer and let something else fill ;; it in. (pop-to-buffer (get-slime-fuzzy-buffer)) (bury-buffer)) - (pop-to-buffer slime-fuzzy-completion-target-buffer) - (goto-char slime-fuzzy-completion-end) - (setq slime-fuzzy-completion-target-buffer nil)) + (pop-to-buffer slime-fuzzy-target-buffer) + (goto-char slime-fuzzy-end) + (setq slime-fuzzy-target-buffer nil)) -(defun slime-fuzzy-completion-save-window-configuration () +(defun slime-fuzzy-save-window-configuration () "Saves the current window configuration, and sets up for the saved configuration to be nullified if the user changes the window configuration further. Adding the nullification routine to window-configuration-change-hook is delayed so that the windows stabalize before we start listening on the hook." - (setq slime-fuzzy-completion-window-configuration + (setq slime-fuzzy-window-configuration (current-window-configuration)) - (setq slime-fuzzy-completion-window-configuration-change-count 0) + (setq slime-fuzzy-window-configuration-change-count 0) (run-with-timer - 0.5 nil 'slime-fuzzy-completion-window-configuration-change-add-hook)) + 0.5 nil 'slime-fuzzy-window-configuration-change-add-hook)) -(defun slime-fuzzy-completion-maybe-restore-window-configuration () +(defun slime-fuzzy-maybe-restore-window-configuration () "Restores the saved window configuration if it has not been nullified." (remove-hook 'window-configuration-change-hook - 'slime-fuzzy-completion-window-configuration-change) - (if (not slime-fuzzy-completion-window-configuration) + 'slime-fuzzy-window-configuration-change) + (if (not slime-fuzzy-window-configuration) nil - (set-window-configuration slime-fuzzy-completion-window-configuration) - (setq slime-fuzzy-completion-window-configuration nil) + (set-window-configuration slime-fuzzy-window-configuration) + (setq slime-fuzzy-window-configuration nil) t)) -(defun slime-fuzzy-completion-window-configuration-change-add-hook () - "Sets up slime-fuzzy-completion-window-configuration-change on +(defun slime-fuzzy-window-configuration-change-add-hook () + "Sets up slime-fuzzy-window-configuration-change on window-configuration-change-hook." (remove-hook 'post-command-hook - 'slime-fuzzy-completion-window-configuration-change-add-hook) + 'slime-fuzzy-window-configuration-change-add-hook) (add-hook 'window-configuration-change-hook - 'slime-fuzzy-completion-window-configuration-change)) + 'slime-fuzzy-window-configuration-change)) -(defun slime-fuzzy-completion-window-configuration-change () +(defun slime-fuzzy-window-configuration-change () "Called on window-configuration-change-hook. Since the window configuration was changed, we nullify our saved configuration." (remove-hook 'window-configuration-change-hook - 'slime-fuzzy-completion-window-configuration-change) - (setq slime-fuzzy-completion-window-configuration nil)) + 'slime-fuzzy-window-configuration-change) + (setq slime-fuzzy-window-configuration nil)) ;;; Interpreting Elisp symbols as CL symbols (package qualifiers) From lgorrie at common-lisp.net Tue Jun 22 14:04:33 2004 From: lgorrie at common-lisp.net (Luke Gorrie) Date: Tue, 22 Jun 2004 07:04:33 -0700 Subject: [slime-cvs] CVS update: slime/doc/slime.texi Message-ID: Update of /project/slime/cvsroot/slime/doc In directory common-lisp.net:/tmp/cvs-serv11940 Modified Files: slime.texi Log Message: Date: Tue Jun 22 07:04:33 2004 Author: lgorrie Index: slime/doc/slime.texi diff -u slime/doc/slime.texi:1.12 slime/doc/slime.texi:1.13 --- slime/doc/slime.texi:1.12 Tue Apr 27 14:25:00 2004 +++ slime/doc/slime.texi Tue Jun 22 07:04:33 2004 @@ -46,7 +46,7 @@ @end macro @set EDITION DRAFT - at set UPDATED @code{$Id: slime.texi,v 1.12 2004/04/27 21:25:00 lgorrie Exp $} + at set UPDATED @code{$Id: slime.texi,v 1.13 2004/06/22 14:04:33 lgorrie Exp $} @titlepage @title SLIME User Manual @@ -1271,7 +1271,8 @@ @unnumberedsec Hackers of the good hack -At the time of writing, the authors and code-contributors of @SLIME{} are: + at SLIME{} is an Extension of @acronym{SLIM} by Eric Marsden. At the +time of writing, the authors and code-contributors of @SLIME{} are: @include contributors.texi @@ -1291,8 +1292,9 @@ help. Thanks to the @acronym{CMUCL} maintainers on the @code{cmucl-imp} list, Dan Barlow at footnote{Dan is one of ``us'', so naturally these thanks apply to the @acronym{SBCL}-hacker side of his -personality.} and Christophe Rhodes of @acronym{SBCL}, and Gary Byers -of OpenMCL. +personality.} and Christophe Rhodes of @acronym{SBCL}, Gary Byers of +OpenMCL, and Martin Simmons of LispWorks (generously sponsored by +Alain Picard of Memetrics). And thanks in advance to the Lisp maintainers who we haven't approached yet.. @code{:-)} From lgorrie at common-lisp.net Tue Jun 22 14:06:32 2004 From: lgorrie at common-lisp.net (Luke Gorrie) Date: Tue, 22 Jun 2004 07:06:32 -0700 Subject: [slime-cvs] CVS update: slime/slime.el Message-ID: Update of /project/slime/cvsroot/slime In directory common-lisp.net:/tmp/cvs-serv18377 Modified Files: slime.el Log Message: Some minor hacking to fuzzy completion: Use the shorter `slime-fuzzy-' symbol prefix. Use markers instead of numbers to remember where the completion is being done. This way they are self-updating. Use `buffer-modified-tick' to detect modifications instead of text comparison. Always restore window configuration when a completion is chosen. For this completion style I think this will work okay [famous last words], and the existing code wasn't XEmacs-compatible for want of window-configuration-change-hook. Now there is no separate keybinding for fuzzy completion, but it's included as a customize option for `slime-complete-symbol-function' Date: Tue Jun 22 07:06:32 2004 Author: lgorrie Index: slime/slime.el diff -u slime/slime.el:1.331 slime/slime.el:1.332 --- slime/slime.el:1.331 Tue Jun 22 01:05:43 2004 +++ slime/slime.el Tue Jun 22 07:06:32 2004 @@ -159,7 +159,9 @@ "Function to perform symbol completion." :group 'slime :type 'function - :options '(slime-complete-symbol* slime-simple-complete-symbol)) + :options '(slime-complete-symbol* + slime-simple-complete-symbol + slime-fuzzy-complete-symbol)) (defcustom slime-connected-hook nil "List of functions to call when SLIME connects to Lisp." @@ -442,7 +444,6 @@ ;; Editing/navigating ("\M-\C-i" slime-complete-symbol :inferior t) ("\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) ("\M-," slime-pop-find-definition-stack :inferior t :sldb t) ("\C-q" slime-close-parens-at-point :prefixed t :inferior t) @@ -535,6 +536,7 @@ [ "Edit Definition..." slime-edit-definition ,C ] [ "Return From Definition" slime-pop-find-definition-stack ,C ] [ "Complete Symbol" slime-complete-symbol ,C ] + [ "Fuzzy Complete Symbol" slime-fuzzy-complete-symbol ,C ] [ "Show REPL" slime-switch-to-output-buffer ,C ] "--" ("Evaluation" @@ -4045,21 +4047,22 @@ (defvar slime-fuzzy-target-buffer nil "The buffer that is the target of the completion activities.") -(defvar slime-fuzzy-window-configuration nil +(defvar slime-fuzzy-saved-window-configuration nil "The saved window configuration before the fuzzy completion buffer popped up.") (defvar slime-fuzzy-start nil - "The beginning of the completion slot in the target buffer.") + "The beginning of the completion slot in the target buffer. +This is a non-advancing marker.") (defvar slime-fuzzy-end nil - "The end of the completion slot in the target buffer.") + "The end of the completion slot in the target buffer. +This is an advancing marker.") (defvar slime-fuzzy-original-text nil "The original text that was in the completion slot in the target buffer. This is what is put back if completion is aborted.") -(defvar slime-fuzzy-current-text nil - "The text that is currently in the completion slot in the -target buffer. If this ever doesn't match, the target buffer has -been modified and we abort without touching it.") +(defvar slime-fuzzy-target-mtime nil + "The expected `buffer-modified-tick' of the target buffer. +This is used to detect unexpected changes by the user.") (defvar slime-fuzzy-first nil "The position of the first completion in the completions buffer. The descriptive text and headers are above this.") @@ -4068,15 +4071,15 @@ after point moves in the completions buffer, the text is not replaced in the target for efficiency.") -(define-derived-mode slime-fuzzy-mode +(define-derived-mode slime-fuzzy-completions-mode fundamental-mode "Fuzzy Completions" "Major mode for presenting fuzzy completion results. -\\ -\\{slime-fuzzy-map}" - (use-local-map slime-fuzzy-map)) +\\ +\\{slime-fuzzy-completions-map}" + (use-local-map slime-fuzzy-completions-map)) -(defvar slime-fuzzy-map +(defvar slime-fuzzy-completions-map (let* ((map (make-sparse-keymap))) (define-key map "q" 'slime-fuzzy-abort) @@ -4094,7 +4097,7 @@ (define-key map [mouse-2] 'slime-fuzzy-click) map) - "Keymap for slime-fuzzy-mode.") + "Keymap for slime-fuzzy-completions-mode.") (defun slime-fuzzy-completions (prefix &optional default-package) "Get the list of sorted completion objects from completing @@ -4139,11 +4142,10 @@ ;; Incomplete (t (slime-minibuffer-respecting-message "Complete but not unique") - (slime-fuzzy-choices-buffer completion-set beg end))) - ))) + (slime-fuzzy-choices-buffer completion-set beg end)))))) -(defun get-slime-fuzzy-buffer () +(defun slime-get-fuzzy-buffer () (get-buffer-create "*Fuzzy Completions*")) (defvar slime-fuzzy-explanation @@ -4181,13 +4183,12 @@ on the completion choice and the slime-fuzzy-select command was run." (interactive "e") - (save-excursion - (with-current-buffer (window-buffer (posn-window (event-end event))) - (save-excursion - (goto-char (posn-point (event-end event))) - (when (get-text-property (point) 'mouse-face) - (slime-fuzzy-insert-from-point) - (slime-fuzzy-select)))))) + (with-current-buffer (window-buffer (posn-window (event-end event))) + (save-excursion + (goto-char (posn-point (event-end event))) + (when (get-text-property (point) 'mouse-face) + (slime-fuzzy-insert-from-point) + (slime-fuzzy-select))))) (defun slime-fuzzy-insert (text) "Inserts `text' into the target buffer in the completion slot. @@ -4195,20 +4196,17 @@ completion process. Otherwise, update all completion variables so that the new text is present." (with-current-buffer slime-fuzzy-target-buffer - (when (not (string-equal slime-fuzzy-current - (buffer-substring slime-fuzzy-start - slime-fuzzy-end))) + (when (and slime-fuzzy-target-mtime + (/= slime-fuzzy-target-mtime + (buffer-modified-tick slime-fuzzy-target-buffer))) + ;; The user has changed the buffer. Bail out. (slime-fuzzy-done) - ;; Not an error, we may be in the post-command-hook. (beep) (message "Target buffer has been modified!")) - (goto-char slime-fuzzy-end) - (insert-and-inherit text) + (goto-char slime-fuzzy-start) (delete-region slime-fuzzy-start slime-fuzzy-end) - (setq slime-fuzzy-end (+ slime-fuzzy-start - (length text))) - (setq slime-fuzzy-current text) - (goto-char slime-fuzzy-end))) + (insert-and-inherit text) + (setq slime-fuzzy-target-mtime (buffer-modified-tick)))) (defun slime-fuzzy-choices-buffer (completions start end) "Creates (if neccessary), populates, and pops up the *Fuzzy @@ -4217,45 +4215,43 @@ `end'. This saves the window configuration before popping the buffer so that it can possibly be restored when the user is done." - (remove-hook 'window-configuration-change-hook - 'slime-fuzzy-window-configuration-change) - (setq slime-fuzzy-start start) - (setq slime-fuzzy-end end) - (setq slime-fuzzy-original-text (buffer-substring start end)) - (setq slime-fuzzy-current slime-fuzzy-original-text) (setq slime-fuzzy-target-buffer (current-buffer)) - (set-buffer (get-slime-fuzzy-buffer)) - (setq buffer-read-only nil) - (erase-buffer) - (slime-fuzzy-mode) - (insert slime-fuzzy-explanation) - (let ((max-length 12)) - (dolist (completion completions) - (setf max-length (max max-length (length (first completion))))) - (insert "Completion:") - (dotimes (i (- max-length 10)) (insert " ")) - (insert "Score:\n") - (dotimes (i max-length) (insert "-")) - (insert " --------\n") - (setq slime-fuzzy-first (point)) - (dolist (completion completions) - (slime-fuzzy-insert-completion-choice completion max-length)) - (setq buffer-read-only t)) - (setq slime-fuzzy-current-completion - (caar completions)) - (slime-fuzzy-insert (caar completions)) - (goto-char slime-fuzzy-first) + (setq slime-fuzzy-target-mtime nil) + (setq slime-fuzzy-start (move-marker (make-marker) start)) + (setq slime-fuzzy-end (move-marker (make-marker) end)) + (set-marker-insertion-type slime-fuzzy-end t) + (setq slime-fuzzy-original-text (buffer-substring start end)) (slime-fuzzy-save-window-configuration) - (pop-to-buffer (current-buffer)) - (make-local-variable 'post-command-hook) - (add-hook 'post-command-hook - 'slime-fuzzy-post-command-hook)) + (with-current-buffer (slime-get-fuzzy-buffer) + (setq buffer-read-only nil) + (erase-buffer) + (slime-fuzzy-completions-mode) + (insert slime-fuzzy-explanation) + (let ((max-length 12)) + (dolist (completion completions) + (setf max-length (max max-length (length (first completion))))) + (insert "Completion:") + (dotimes (i (- max-length 10)) (insert " ")) + (insert "Score:\n") + (dotimes (i max-length) (insert "-")) + (insert " --------\n") + (setq slime-fuzzy-first (point)) + (dolist (completion completions) + (slime-fuzzy-insert-completion-choice completion max-length)) + (setq buffer-read-only t)) + (setq slime-fuzzy-current-completion + (caar completions)) + (slime-fuzzy-insert (caar completions)) + (goto-char slime-fuzzy-first) + (pop-to-buffer (current-buffer)) + (add-hook (make-local-variable 'post-command-hook) + 'slime-fuzzy-post-command-hook))) (defun slime-fuzzy-insert-from-point () "Inserts the completion that is under point in the completions buffer into the target buffer. If the completion in question had already been inserted, it does nothing." - (with-current-buffer (get-slime-fuzzy-buffer) + (with-current-buffer (slime-get-fuzzy-buffer) (let ((current-completion (get-text-property (point) 'completion))) (when (and current-completion (not (eq slime-fuzzy-current-completion @@ -4306,7 +4302,7 @@ was selected." (interactive) (when slime-fuzzy-target-buffer - (with-current-buffer (get-slime-fuzzy-buffer) + (with-current-buffer (slime-get-fuzzy-buffer) (let ((completion (get-text-property (point) 'completion))) (when completion (slime-fuzzy-insert (first completion)) @@ -4322,14 +4318,8 @@ (set-buffer slime-fuzzy-target-buffer) (remove-hook 'post-command-hook 'slime-fuzzy-post-command-hook) - (if (slime-fuzzy-maybe-restore-window-configuration) - (bury-buffer (get-slime-fuzzy-buffer)) - ;; We couldn't restore the windows, so just bury the - ;; fuzzy completions buffer and let something else fill - ;; it in. - (pop-to-buffer (get-slime-fuzzy-buffer)) - (bury-buffer)) - (pop-to-buffer slime-fuzzy-target-buffer) + (slime-fuzzy-restore-window-configuration) + (bury-buffer (slime-get-fuzzy-buffer)) (goto-char slime-fuzzy-end) (setq slime-fuzzy-target-buffer nil)) @@ -4339,37 +4329,15 @@ window configuration further. Adding the nullification routine to window-configuration-change-hook is delayed so that the windows stabalize before we start listening on the hook." - (setq slime-fuzzy-window-configuration - (current-window-configuration)) - (setq slime-fuzzy-window-configuration-change-count 0) - (run-with-timer - 0.5 nil 'slime-fuzzy-window-configuration-change-add-hook)) + (setq slime-fuzzy-saved-window-configuration + (current-window-configuration))) -(defun slime-fuzzy-maybe-restore-window-configuration () +(defun slime-fuzzy-restore-window-configuration () "Restores the saved window configuration if it has not been nullified." - (remove-hook 'window-configuration-change-hook - 'slime-fuzzy-window-configuration-change) - (if (not slime-fuzzy-window-configuration) - nil - (set-window-configuration slime-fuzzy-window-configuration) - (setq slime-fuzzy-window-configuration nil) - t)) - -(defun slime-fuzzy-window-configuration-change-add-hook () - "Sets up slime-fuzzy-window-configuration-change on -window-configuration-change-hook." - (remove-hook 'post-command-hook - 'slime-fuzzy-window-configuration-change-add-hook) - (add-hook 'window-configuration-change-hook - 'slime-fuzzy-window-configuration-change)) - -(defun slime-fuzzy-window-configuration-change () - "Called on window-configuration-change-hook. Since the window -configuration was changed, we nullify our saved configuration." - (remove-hook 'window-configuration-change-hook - 'slime-fuzzy-window-configuration-change) - (setq slime-fuzzy-window-configuration nil)) + (when slime-fuzzy-saved-window-configuration + (set-window-configuration slime-fuzzy-saved-window-configuration) + (setq slime-fuzzy-saved-window-configuration nil))) ;;; Interpreting Elisp symbols as CL symbols (package qualifiers) From lgorrie at common-lisp.net Tue Jun 22 14:06:56 2004 From: lgorrie at common-lisp.net (Luke Gorrie) Date: Tue, 22 Jun 2004 07:06:56 -0700 Subject: [slime-cvs] CVS update: slime/doc/Makefile Message-ID: Update of /project/slime/cvsroot/slime/doc In directory common-lisp.net:/tmp/cvs-serv18938/doc Modified Files: Makefile Log Message: (contributors.texi): The contributors list in the manual is now sorted by most number of ChangeLog entries. Patch from Michael Weber. Date: Tue Jun 22 07:06:56 2004 Author: lgorrie Index: slime/doc/Makefile diff -u slime/doc/Makefile:1.3 slime/doc/Makefile:1.4 --- slime/doc/Makefile:1.3 Fri Apr 16 12:31:11 2004 +++ slime/doc/Makefile Tue Jun 22 07:06:56 2004 @@ -42,15 +42,16 @@ # Some special-case TeX-escaping of international characters. contributors.texi: ../ChangeLog Makefile texinfo-tabulate.awk cat ../ChangeLog | \ - grep '^[0-9]' | \ - sed -e 's/^[^ ]* *//' -e 's/ *<.*//' | \ - (cat; echo 'Eric Marsden') | \ - sort -u | \ + sed -ne '/^[0-9]/{s/^[^ ]* *//; s/ *<.*//; p;}' | \ + sort -d | \ + uniq -c | \ + sort -nr| \ + sed -e 's/^[^A-Z]*//' | \ awk -f texinfo-tabulate.awk | \ sed -e 's/\o370/@norsko{}/g' \ > $@ -.INTERMEDIATE: contributors.texi +#.INTERMEDIATE: contributors.texi # Debian's install-info wants a --section argument. section := $(shell grep INFO-DIR-SECTION $(infofiles) | sed 's/INFO-DIR-SECTION //') From lgorrie at common-lisp.net Tue Jun 22 14:36:11 2004 From: lgorrie at common-lisp.net (Luke Gorrie) Date: Tue, 22 Jun 2004 07:36:11 -0700 Subject: [slime-cvs] CVS update: slime/ChangeLog Message-ID: Update of /project/slime/cvsroot/slime In directory common-lisp.net:/tmp/cvs-serv7352 Modified Files: ChangeLog Log Message: Date: Tue Jun 22 07:36:11 2004 Author: lgorrie Index: slime/ChangeLog diff -u slime/ChangeLog:1.420 slime/ChangeLog:1.421 --- slime/ChangeLog:1.420 Tue Jun 22 01:02:45 2004 +++ slime/ChangeLog Tue Jun 22 07:36:11 2004 @@ -1,3 +1,22 @@ +2004-06-22 Luke Gorrie + + * doc/Makefile (contributors.texi): The contributors list in the + manual is now sorted by most number of ChangeLog entries. Patch + from Michael Weber. + + * slime.el: Some minor hacking to fuzzy completion: + Use the shorter `slime-fuzzy-' symbol prefix. + Use markers instead of numbers to remember where the completion is + being done. This way they are self-updating. + Use `buffer-modified-tick' to detect modifications instead of text + comparison. + Always restore window configuration when a completion is + chosen. For this completion style I think this will work okay + [famous last words], and the existing code wasn't + XEmacs-compatible for want of window-configuration-change-hook. + Now there is no separate keybinding for fuzzy completion, but it's + included as a customize option for `slime-complete-symbol-function' + 2004-06-22 Brian Downing * slime.el, swank.lisp: Added "fuzzy completion." From lgorrie at common-lisp.net Tue Jun 22 14:40:11 2004 From: lgorrie at common-lisp.net (Luke Gorrie) Date: Tue, 22 Jun 2004 07:40:11 -0700 Subject: [slime-cvs] CVS update: slime/ChangeLog Message-ID: Update of /project/slime/cvsroot/slime In directory common-lisp.net:/tmp/cvs-serv25451 Modified Files: ChangeLog Log Message: *** empty log message *** Date: Tue Jun 22 07:40:11 2004 Author: lgorrie Index: slime/ChangeLog diff -u slime/ChangeLog:1.421 slime/ChangeLog:1.422 --- slime/ChangeLog:1.421 Tue Jun 22 07:36:11 2004 +++ slime/ChangeLog Tue Jun 22 07:40:11 2004 @@ -20,8 +20,6 @@ 2004-06-22 Brian Downing * slime.el, swank.lisp: Added "fuzzy completion." - [I'm hacking the elisp end of this at the moment. Checked in now - so that I can use CVS on it. -luke] 2004-06-22 Matthew Danish From lgorrie at common-lisp.net Tue Jun 22 17:02:50 2004 From: lgorrie at common-lisp.net (Luke Gorrie) Date: Tue, 22 Jun 2004 10:02:50 -0700 Subject: [slime-cvs] CVS update: slime/slime.el Message-ID: Update of /project/slime/cvsroot/slime In directory common-lisp.net:/tmp/cvs-serv6058 Modified Files: slime.el Log Message: Backed out all of my changes to fuzzy completion. I was too hasty and didn't do good things. Now it's back in pristine state from Brian's patch -- use `C-c M-i' to fuzzy-complete. Date: Tue Jun 22 10:02:50 2004 Author: lgorrie Index: slime/slime.el diff -u slime/slime.el:1.332 slime/slime.el:1.333 --- slime/slime.el:1.332 Tue Jun 22 07:06:32 2004 +++ slime/slime.el Tue Jun 22 10:02:50 2004 @@ -159,9 +159,7 @@ "Function to perform symbol completion." :group 'slime :type 'function - :options '(slime-complete-symbol* - slime-simple-complete-symbol - slime-fuzzy-complete-symbol)) + :options '(slime-complete-symbol* slime-simple-complete-symbol)) (defcustom slime-connected-hook nil "List of functions to call when SLIME connects to Lisp." @@ -444,6 +442,7 @@ ;; Editing/navigating ("\M-\C-i" slime-complete-symbol :inferior t) ("\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) ("\M-," slime-pop-find-definition-stack :inferior t :sldb t) ("\C-q" slime-close-parens-at-point :prefixed t :inferior t) @@ -536,7 +535,6 @@ [ "Edit Definition..." slime-edit-definition ,C ] [ "Return From Definition" slime-pop-find-definition-stack ,C ] [ "Complete Symbol" slime-complete-symbol ,C ] - [ "Fuzzy Complete Symbol" slime-fuzzy-complete-symbol ,C ] [ "Show REPL" slime-switch-to-output-buffer ,C ] "--" ("Evaluation" @@ -4045,59 +4043,58 @@ ;;; Fuzzy completion -(defvar slime-fuzzy-target-buffer nil +(defvar slime-fuzzy-completion-target-buffer nil "The buffer that is the target of the completion activities.") -(defvar slime-fuzzy-saved-window-configuration nil +(defvar slime-fuzzy-completion-window-configuration nil "The saved window configuration before the fuzzy completion buffer popped up.") -(defvar slime-fuzzy-start nil - "The beginning of the completion slot in the target buffer. -This is a non-advancing marker.") -(defvar slime-fuzzy-end nil - "The end of the completion slot in the target buffer. -This is an advancing marker.") -(defvar slime-fuzzy-original-text nil +(defvar slime-fuzzy-completion-start nil + "The beginning of the completion slot in the target buffer.") +(defvar slime-fuzzy-completion-end nil + "The end of the completion slot in the target buffer.") +(defvar slime-fuzzy-completion-original-text nil "The original text that was in the completion slot in the target buffer. This is what is put back if completion is aborted.") -(defvar slime-fuzzy-target-mtime nil - "The expected `buffer-modified-tick' of the target buffer. -This is used to detect unexpected changes by the user.") -(defvar slime-fuzzy-first nil +(defvar slime-fuzzy-completion-current-text nil + "The text that is currently in the completion slot in the +target buffer. If this ever doesn't match, the target buffer has +been modified and we abort without touching it.") +(defvar slime-fuzzy-completion-first nil "The position of the first completion in the completions buffer. The descriptive text and headers are above this.") -(defvar slime-fuzzy-current-completion nil +(defvar slime-fuzzy-completion-current-completion nil "The current completion object. If this is the same before and after point moves in the completions buffer, the text is not replaced in the target for efficiency.") -(define-derived-mode slime-fuzzy-completions-mode +(define-derived-mode slime-fuzzy-mode fundamental-mode "Fuzzy Completions" "Major mode for presenting fuzzy completion results. -\\ -\\{slime-fuzzy-completions-map}" - (use-local-map slime-fuzzy-completions-map)) +\\ +\\{slime-fuzzy-map}" + (use-local-map slime-fuzzy-map)) -(defvar slime-fuzzy-completions-map +(defvar slime-fuzzy-map (let* ((map (make-sparse-keymap))) - (define-key map "q" 'slime-fuzzy-abort) - (define-key map "\r" 'slime-fuzzy-select) + (define-key map "q" 'slime-fuzzy-completion-abort) + (define-key map "\r" 'slime-fuzzy-completion-select) - (define-key map "n" 'slime-fuzzy-next) - (define-key map "\M-n" 'slime-fuzzy-next) + (define-key map "n" 'slime-fuzzy-completion-next) + (define-key map "\M-n" 'slime-fuzzy-completion-next) - (define-key map "p" 'slime-fuzzy-prev) - (define-key map "\M-p" 'slime-fuzzy-prev) + (define-key map "p" 'slime-fuzzy-completion-prev) + (define-key map "\M-p" 'slime-fuzzy-completion-prev) (define-key map "\d" 'scroll-down) (define-key map " " 'scroll-up) - (define-key map [mouse-2] 'slime-fuzzy-click) + (define-key map [mouse-2] 'slime-fuzzy-completion-click) map) - "Keymap for slime-fuzzy-completions-mode.") + "Keymap for slime-fuzzy-mode.") (defun slime-fuzzy-completions (prefix &optional default-package) "Get the list of sorted completion objects from completing @@ -4110,7 +4107,7 @@ (slime-find-buffer-package) (slime-buffer-package)))))) -(defun slime-fuzzy-selected (prefix completion) +(defun slime-fuzzy-completion-selected (prefix completion) "Tell the connected Lisp that the user selected completion `completion' as the completion for `prefix'." (let ((no-properties (copy-sequence prefix))) @@ -4142,10 +4139,11 @@ ;; Incomplete (t (slime-minibuffer-respecting-message "Complete but not unique") - (slime-fuzzy-choices-buffer completion-set beg end)))))) + (slime-fuzzy-completion-choices-buffer completion-set beg end))) + ))) -(defun slime-get-fuzzy-buffer () +(defun get-slime-fuzzy-buffer () (get-buffer-create "*Fuzzy Completions*")) (defvar slime-fuzzy-explanation @@ -4178,166 +4176,200 @@ (insert "\n") (put-text-property start (point) 'completion completion)))) -(defun slime-fuzzy-click (event) +(defun slime-fuzzy-completion-click (event) "Handle a mouse-2 click on a completion choice as if point were -on the completion choice and the slime-fuzzy-select +on the completion choice and the slime-fuzzy-completion-select command was run." (interactive "e") - (with-current-buffer (window-buffer (posn-window (event-end event))) - (save-excursion - (goto-char (posn-point (event-end event))) - (when (get-text-property (point) 'mouse-face) - (slime-fuzzy-insert-from-point) - (slime-fuzzy-select))))) + (save-excursion + (with-current-buffer (window-buffer (posn-window (event-end event))) + (save-excursion + (goto-char (posn-point (event-end event))) + (when (get-text-property (point) 'mouse-face) + (slime-fuzzy-completion-insert-from-point) + (slime-fuzzy-completion-select)))))) -(defun slime-fuzzy-insert (text) +(defun slime-fuzzy-completion-insert (text) "Inserts `text' into the target buffer in the completion slot. If the buffer has been modified in the meantime, abort the completion process. Otherwise, update all completion variables so that the new text is present." - (with-current-buffer slime-fuzzy-target-buffer - (when (and slime-fuzzy-target-mtime - (/= slime-fuzzy-target-mtime - (buffer-modified-tick slime-fuzzy-target-buffer))) - ;; The user has changed the buffer. Bail out. - (slime-fuzzy-done) + (with-current-buffer slime-fuzzy-completion-target-buffer + (when (not (string-equal slime-fuzzy-completion-current + (buffer-substring slime-fuzzy-completion-start + slime-fuzzy-completion-end))) + (slime-fuzzy-completion-done) + ;; Not an error, we may be in the post-command-hook. (beep) (message "Target buffer has been modified!")) - (goto-char slime-fuzzy-start) - (delete-region slime-fuzzy-start slime-fuzzy-end) + (goto-char slime-fuzzy-completion-end) (insert-and-inherit text) - (setq slime-fuzzy-target-mtime (buffer-modified-tick)))) + (delete-region slime-fuzzy-completion-start slime-fuzzy-completion-end) + (setq slime-fuzzy-completion-end (+ slime-fuzzy-completion-start + (length text))) + (setq slime-fuzzy-completion-current text) + (goto-char slime-fuzzy-completion-end))) -(defun slime-fuzzy-choices-buffer (completions start end) +(defun slime-fuzzy-completion-choices-buffer (completions start end) "Creates (if neccessary), populates, and pops up the *Fuzzy Completions* buffer with the completions from `completions' and the completion slot in the current buffer bounded by `start' and `end'. This saves the window configuration before popping the buffer so that it can possibly be restored when the user is done." - (setq slime-fuzzy-target-buffer (current-buffer)) - (setq slime-fuzzy-target-mtime nil) - (setq slime-fuzzy-start (move-marker (make-marker) start)) - (setq slime-fuzzy-end (move-marker (make-marker) end)) - (set-marker-insertion-type slime-fuzzy-end t) - (setq slime-fuzzy-original-text (buffer-substring start end)) - (slime-fuzzy-save-window-configuration) - (with-current-buffer (slime-get-fuzzy-buffer) - (setq buffer-read-only nil) - (erase-buffer) - (slime-fuzzy-completions-mode) - (insert slime-fuzzy-explanation) - (let ((max-length 12)) - (dolist (completion completions) - (setf max-length (max max-length (length (first completion))))) - (insert "Completion:") - (dotimes (i (- max-length 10)) (insert " ")) - (insert "Score:\n") - (dotimes (i max-length) (insert "-")) - (insert " --------\n") - (setq slime-fuzzy-first (point)) - (dolist (completion completions) - (slime-fuzzy-insert-completion-choice completion max-length)) - (setq buffer-read-only t)) - (setq slime-fuzzy-current-completion - (caar completions)) - (slime-fuzzy-insert (caar completions)) - (goto-char slime-fuzzy-first) - (pop-to-buffer (current-buffer)) - (add-hook (make-local-variable 'post-command-hook) - 'slime-fuzzy-post-command-hook))) + (remove-hook 'window-configuration-change-hook + 'slime-fuzzy-completion-window-configuration-change) + (setq slime-fuzzy-completion-start start) + (setq slime-fuzzy-completion-end end) + (setq slime-fuzzy-completion-original-text (buffer-substring start end)) + (setq slime-fuzzy-completion-current slime-fuzzy-completion-original-text) + (setq slime-fuzzy-completion-target-buffer (current-buffer)) + (set-buffer (get-slime-fuzzy-buffer)) + (setq buffer-read-only nil) + (erase-buffer) + (slime-fuzzy-mode) + (insert slime-fuzzy-explanation) + (let ((max-length 12)) + (dolist (completion completions) + (setf max-length (max max-length (length (first completion))))) + (insert "Completion:") + (dotimes (i (- max-length 10)) (insert " ")) + (insert "Score:\n") + (dotimes (i max-length) (insert "-")) + (insert " --------\n") + (setq slime-fuzzy-completion-first (point)) + (dolist (completion completions) + (slime-fuzzy-insert-completion-choice completion max-length)) + (setq buffer-read-only t)) + (setq slime-fuzzy-completion-current-completion + (caar completions)) + (slime-fuzzy-completion-insert (caar completions)) + (goto-char slime-fuzzy-completion-first) + (slime-fuzzy-completion-save-window-configuration) + (pop-to-buffer (current-buffer)) + (make-local-variable 'post-command-hook) + (add-hook 'post-command-hook + 'slime-fuzzy-completion-post-command-hook)) -(defun slime-fuzzy-insert-from-point () +(defun slime-fuzzy-completion-insert-from-point () "Inserts the completion that is under point in the completions buffer into the target buffer. If the completion in question had already been inserted, it does nothing." - (with-current-buffer (slime-get-fuzzy-buffer) + (with-current-buffer (get-slime-fuzzy-buffer) (let ((current-completion (get-text-property (point) 'completion))) (when (and current-completion - (not (eq slime-fuzzy-current-completion + (not (eq slime-fuzzy-completion-current-completion current-completion))) - (slime-fuzzy-insert + (slime-fuzzy-completion-insert (first (get-text-property (point) 'completion))) - (setq slime-fuzzy-current-completion + (setq slime-fuzzy-completion-current-completion current-completion))))) -(defun slime-fuzzy-post-command-hook () +(defun slime-fuzzy-completion-post-command-hook () "The post-command-hook for the *Fuzzy Completions* buffer. This makes sure the completion slot in the target buffer matches the completion that point is on in the completions buffer." (condition-case err - (when slime-fuzzy-target-buffer - (slime-fuzzy-insert-from-point)) + (when slime-fuzzy-completion-target-buffer + (slime-fuzzy-completion-insert-from-point)) (error ;; Because this is called on the post-command-hook, we mustn't let ;; errors propagate. - (message "Error in slime-fuzzy-post-command-hook: %S" err)))) + (message "Error in slime-fuzzy-completion-post-command-hook: %S" err)))) -(defun slime-fuzzy-next () +(defun slime-fuzzy-completion-next () "Moves point directly to the next completion in the completions buffer." (interactive) (goto-char (next-single-char-property-change (point) 'completion))) -(defun slime-fuzzy-prev () +(defun slime-fuzzy-completion-prev () "Moves point directly to the previous completion in the completions buffer." (interactive) (goto-char (previous-single-char-property-change (point) 'completion - nil slime-fuzzy-first))) + nil slime-fuzzy-completion-first))) -(defun slime-fuzzy-abort () +(defun slime-fuzzy-completion-abort () "Aborts the completion process, setting the completions slot in the target buffer back to its original contents." (interactive) - (when slime-fuzzy-target-buffer - (slime-fuzzy-insert slime-fuzzy-original-text) - (slime-fuzzy-done))) + (when slime-fuzzy-completion-target-buffer + (slime-fuzzy-completion-insert slime-fuzzy-completion-original-text) + (slime-fuzzy-completion-done))) -(defun slime-fuzzy-select () +(defun slime-fuzzy-completion-select () "Selects the current completion, making sure that it is inserted into the target buffer. This tells the connected Lisp what completion was selected." (interactive) - (when slime-fuzzy-target-buffer - (with-current-buffer (slime-get-fuzzy-buffer) + (when slime-fuzzy-completion-target-buffer + (with-current-buffer (get-slime-fuzzy-buffer) (let ((completion (get-text-property (point) 'completion))) (when completion - (slime-fuzzy-insert (first completion)) - (slime-fuzzy-selected slime-fuzzy-original-text + (slime-fuzzy-completion-insert (first completion)) + (slime-fuzzy-completion-selected slime-fuzzy-completion-original-text completion) - (slime-fuzzy-done)))))) + (slime-fuzzy-completion-done)))))) -(defun slime-fuzzy-done () +(defun slime-fuzzy-completion-done () "Cleans up after the completion process. This removes all hooks, and attempts to restore the window configuration. If this fails, it just burys the completions buffer and leaves the window configuration alone." - (set-buffer slime-fuzzy-target-buffer) + (set-buffer slime-fuzzy-completion-target-buffer) (remove-hook 'post-command-hook - 'slime-fuzzy-post-command-hook) - (slime-fuzzy-restore-window-configuration) - (bury-buffer (slime-get-fuzzy-buffer)) - (goto-char slime-fuzzy-end) - (setq slime-fuzzy-target-buffer nil)) + 'slime-fuzzy-completion-post-command-hook) + (if (slime-fuzzy-completion-maybe-restore-window-configuration) + (bury-buffer (get-slime-fuzzy-buffer)) + ;; We couldn't restore the windows, so just bury the + ;; fuzzy completions buffer and let something else fill + ;; it in. + (pop-to-buffer (get-slime-fuzzy-buffer)) + (bury-buffer)) + (pop-to-buffer slime-fuzzy-completion-target-buffer) + (goto-char slime-fuzzy-completion-end) + (setq slime-fuzzy-completion-target-buffer nil)) -(defun slime-fuzzy-save-window-configuration () +(defun slime-fuzzy-completion-save-window-configuration () "Saves the current window configuration, and sets up for the saved configuration to be nullified if the user changes the window configuration further. Adding the nullification routine to window-configuration-change-hook is delayed so that the windows stabalize before we start listening on the hook." - (setq slime-fuzzy-saved-window-configuration - (current-window-configuration))) + (setq slime-fuzzy-completion-window-configuration + (current-window-configuration)) + (setq slime-fuzzy-completion-window-configuration-change-count 0) + (run-with-timer + 0.5 nil 'slime-fuzzy-completion-window-configuration-change-add-hook)) -(defun slime-fuzzy-restore-window-configuration () +(defun slime-fuzzy-completion-maybe-restore-window-configuration () "Restores the saved window configuration if it has not been nullified." - (when slime-fuzzy-saved-window-configuration - (set-window-configuration slime-fuzzy-saved-window-configuration) - (setq slime-fuzzy-saved-window-configuration nil))) + (remove-hook 'window-configuration-change-hook + 'slime-fuzzy-completion-window-configuration-change) + (if (not slime-fuzzy-completion-window-configuration) + nil + (set-window-configuration slime-fuzzy-completion-window-configuration) + (setq slime-fuzzy-completion-window-configuration nil) + t)) + +(defun slime-fuzzy-completion-window-configuration-change-add-hook () + "Sets up slime-fuzzy-completion-window-configuration-change on +window-configuration-change-hook." + (remove-hook 'post-command-hook + 'slime-fuzzy-completion-window-configuration-change-add-hook) + (add-hook 'window-configuration-change-hook + 'slime-fuzzy-completion-window-configuration-change)) + +(defun slime-fuzzy-completion-window-configuration-change () + "Called on window-configuration-change-hook. Since the window +configuration was changed, we nullify our saved configuration." + (remove-hook 'window-configuration-change-hook + 'slime-fuzzy-completion-window-configuration-change) + (setq slime-fuzzy-completion-window-configuration nil)) ;;; Interpreting Elisp symbols as CL symbols (package qualifiers) From lgorrie at common-lisp.net Tue Jun 22 17:02:57 2004 From: lgorrie at common-lisp.net (Luke Gorrie) Date: Tue, 22 Jun 2004 10:02:57 -0700 Subject: [slime-cvs] CVS update: slime/ChangeLog Message-ID: Update of /project/slime/cvsroot/slime In directory common-lisp.net:/tmp/cvs-serv7227 Modified Files: ChangeLog Log Message: Date: Tue Jun 22 10:02:57 2004 Author: lgorrie Index: slime/ChangeLog diff -u slime/ChangeLog:1.422 slime/ChangeLog:1.423 --- slime/ChangeLog:1.422 Tue Jun 22 07:40:11 2004 +++ slime/ChangeLog Tue Jun 22 10:02:57 2004 @@ -1,5 +1,9 @@ 2004-06-22 Luke Gorrie + * slime.el: Backed out all of my changes to fuzzy completion. I + was too hasty and didn't do good things. Now it's back in pristine + state from Brian's patch -- use `C-c M-i' to fuzzy-complete. + * doc/Makefile (contributors.texi): The contributors list in the manual is now sorted by most number of ChangeLog entries. Patch from Michael Weber. From lgorrie at common-lisp.net Tue Jun 22 17:04:07 2004 From: lgorrie at common-lisp.net (Luke Gorrie) Date: Tue, 22 Jun 2004 10:04:07 -0700 Subject: [slime-cvs] CVS update: slime/doc/slime.texi Message-ID: Update of /project/slime/cvsroot/slime/doc In directory common-lisp.net:/tmp/cvs-serv11189/doc Modified Files: slime.texi Log Message: Noted ABCL support. Date: Tue Jun 22 10:04:07 2004 Author: lgorrie Index: slime/doc/slime.texi diff -u slime/doc/slime.texi:1.13 slime/doc/slime.texi:1.14 --- slime/doc/slime.texi:1.13 Tue Jun 22 07:04:33 2004 +++ slime/doc/slime.texi Tue Jun 22 10:04:06 2004 @@ -46,7 +46,7 @@ @end macro @set EDITION DRAFT - at set UPDATED @code{$Id: slime.texi,v 1.13 2004/06/22 14:04:33 lgorrie Exp $} + at set UPDATED @code{$Id: slime.texi,v 1.14 2004/06/22 17:04:06 lgorrie Exp $} @titlepage @title SLIME User Manual @@ -239,6 +239,8 @@ LispWorks @item Allegro Common Lisp (@acronym{ACL}) + at item +Armed Bear Common Lisp (@acronym{ABCL}) @end itemize Most features work uniformly across implementations, but some are From lgorrie at common-lisp.net Tue Jun 22 17:04:17 2004 From: lgorrie at common-lisp.net (Luke Gorrie) Date: Tue, 22 Jun 2004 10:04:17 -0700 Subject: [slime-cvs] CVS update: slime/ChangeLog Message-ID: Update of /project/slime/cvsroot/slime In directory common-lisp.net:/tmp/cvs-serv12084 Modified Files: ChangeLog Log Message: Date: Tue Jun 22 10:04:17 2004 Author: lgorrie Index: slime/ChangeLog diff -u slime/ChangeLog:1.423 slime/ChangeLog:1.424 --- slime/ChangeLog:1.423 Tue Jun 22 10:02:57 2004 +++ slime/ChangeLog Tue Jun 22 10:04:17 2004 @@ -1,5 +1,7 @@ 2004-06-22 Luke Gorrie + * doc/slime.texi: Noted ABCL support. + * slime.el: Backed out all of my changes to fuzzy completion. I was too hasty and didn't do good things. Now it's back in pristine state from Brian's patch -- use `C-c M-i' to fuzzy-complete. From hgvpa at front.ru Tue Jun 22 18:02:55 2004 From: hgvpa at front.ru (Estela Bergeron) Date: Tue, 22 Jun 2004 13:02:55 -0500 Subject: [slime-cvs] Incredible Software Deals cloud formation fetishists living with 47 Message-ID: <871615i1fzx9$yf6u6i63$8520d3v8@GY377466478999> An HTML attachment was scrubbed... URL: From asimon at common-lisp.net Wed Jun 23 09:59:58 2004 From: asimon at common-lisp.net (Andras Simon) Date: Wed, 23 Jun 2004 02:59:58 -0700 Subject: [slime-cvs] CVS update: slime/doc/slime.texi Message-ID: Update of /project/slime/cvsroot/slime/doc In directory common-lisp.net:/tmp/cvs-serv21104 Modified Files: slime.texi Log Message: Thanks to Peter Graves. Date: Wed Jun 23 02:59:58 2004 Author: asimon Index: slime/doc/slime.texi diff -u slime/doc/slime.texi:1.14 slime/doc/slime.texi:1.15 --- slime/doc/slime.texi:1.14 Tue Jun 22 10:04:06 2004 +++ slime/doc/slime.texi Wed Jun 23 02:59:58 2004 @@ -46,7 +46,7 @@ @end macro @set EDITION DRAFT - at set UPDATED @code{$Id: slime.texi,v 1.14 2004/06/22 17:04:06 lgorrie Exp $} + at set UPDATED @code{$Id: slime.texi,v 1.15 2004/06/23 09:59:58 asimon Exp $} @titlepage @title SLIME User Manual @@ -1295,8 +1295,8 @@ @code{cmucl-imp} list, Dan Barlow at footnote{Dan is one of ``us'', so naturally these thanks apply to the @acronym{SBCL}-hacker side of his personality.} and Christophe Rhodes of @acronym{SBCL}, Gary Byers of -OpenMCL, and Martin Simmons of LispWorks (generously sponsored by -Alain Picard of Memetrics). +OpenMCL, Peter Graves of @acronym{ABCL} and Martin Simmons of +LispWorks (generously sponsored by Alain Picard of Memetrics). And thanks in advance to the Lisp maintainers who we haven't approached yet.. @code{:-)} From bdowning at common-lisp.net Wed Jun 23 22:51:00 2004 From: bdowning at common-lisp.net (Brian Downing) Date: Wed, 23 Jun 2004 15:51:00 -0700 Subject: [slime-cvs] CVS update: slime/ChangeLog slime/slime.el Message-ID: Update of /project/slime/cvsroot/slime In directory common-lisp.net:/tmp/cvs-serv29908 Modified Files: ChangeLog slime.el Log Message: * slime.el: Re-added most of Luke's patches from yesterday. It has the shortened names, uses markers instead of stored `(point)' values, and `slime-fuzzy-complete-symbol' is an option for `slime-complete-symbol-function'. It still string compares the target buffer instead of using `(buffer-modified-tick)'. I left the `C-c M-i' keybinding in, as it allows use of the regular completion as well. If there's an objection to this it can be removed. `window-configuration-change-hook' is used if the variable is present, and ignored it not. This neatly sidesteps its absence in XEmacs while not killing the functionality for GNU Emacs. * doc/slime.texi: Added a command entry and short description for `C-c M-I, slime-fuzzy-complete-symbol', and added its existence to the `slime-complete-symbol-function' documentation. Date: Wed Jun 23 15:51:00 2004 Author: bdowning Index: slime/ChangeLog diff -u slime/ChangeLog:1.424 slime/ChangeLog:1.425 --- slime/ChangeLog:1.424 Tue Jun 22 10:04:17 2004 +++ slime/ChangeLog Wed Jun 23 15:50:59 2004 @@ -1,3 +1,22 @@ +2004-06-23 Brian Downing + + * slime.el: Re-added most of Luke's patches from yesterday. It + has the shortened names, uses markers instead of stored `(point)' + values, and `slime-fuzzy-complete-symbol' is an option for + `slime-complete-symbol-function'. + It still string compares the target buffer instead of using + `(buffer-modified-tick)'. + I left the `C-c M-i' keybinding in, as it allows use of the + regular completion as well. If there's an objection to this it + can be removed. + `window-configuration-change-hook' is used if the variable is + present, and ignored it not. This neatly sidesteps its absence in + XEmacs while not killing the functionality for GNU Emacs. + + * doc/slime.texi: Added a command entry and short description for + `C-c M-I, slime-fuzzy-complete-symbol', and added its existence to + the `slime-complete-symbol-function' documentation. + 2004-06-22 Luke Gorrie * doc/slime.texi: Noted ABCL support. Index: slime/slime.el diff -u slime/slime.el:1.333 slime/slime.el:1.334 --- slime/slime.el:1.333 Tue Jun 22 10:02:50 2004 +++ slime/slime.el Wed Jun 23 15:50:59 2004 @@ -159,7 +159,9 @@ "Function to perform symbol completion." :group 'slime :type 'function - :options '(slime-complete-symbol* slime-simple-complete-symbol)) + :options '(slime-complete-symbol* + slime-simple-complete-symbol + slime-fuzzy-complete-symbol)) (defcustom slime-connected-hook nil "List of functions to call when SLIME connects to Lisp." @@ -535,6 +537,7 @@ [ "Edit Definition..." slime-edit-definition ,C ] [ "Return From Definition" slime-pop-find-definition-stack ,C ] [ "Complete Symbol" slime-complete-symbol ,C ] + [ "Fuzzy Complete Symbol" slime-fuzzy-complete-symbol ,C ] [ "Show REPL" slime-switch-to-output-buffer ,C ] "--" ("Evaluation" @@ -4043,58 +4046,60 @@ ;;; Fuzzy completion -(defvar slime-fuzzy-completion-target-buffer nil +(defvar slime-fuzzy-target-buffer nil "The buffer that is the target of the completion activities.") -(defvar slime-fuzzy-completion-window-configuration nil +(defvar slime-fuzzy-saved-window-configuration nil "The saved window configuration before the fuzzy completion buffer popped up.") -(defvar slime-fuzzy-completion-start nil - "The beginning of the completion slot in the target buffer.") -(defvar slime-fuzzy-completion-end nil - "The end of the completion slot in the target buffer.") -(defvar slime-fuzzy-completion-original-text nil +(defvar slime-fuzzy-start nil + "The beginning of the completion slot in the target buffer. +This is a non-advancing marker.") +(defvar slime-fuzzy-end nil + "The end of the completion slot in the target buffer. +This is an advancing marker.") +(defvar slime-fuzzy-original-text nil "The original text that was in the completion slot in the target buffer. This is what is put back if completion is aborted.") -(defvar slime-fuzzy-completion-current-text nil +(defvar slime-fuzzy-text nil "The text that is currently in the completion slot in the target buffer. If this ever doesn't match, the target buffer has been modified and we abort without touching it.") -(defvar slime-fuzzy-completion-first nil +(defvar slime-fuzzy-first nil "The position of the first completion in the completions buffer. The descriptive text and headers are above this.") -(defvar slime-fuzzy-completion-current-completion nil +(defvar slime-fuzzy-current-completion nil "The current completion object. If this is the same before and after point moves in the completions buffer, the text is not replaced in the target for efficiency.") -(define-derived-mode slime-fuzzy-mode +(define-derived-mode slime-fuzzy-completions-mode fundamental-mode "Fuzzy Completions" "Major mode for presenting fuzzy completion results. -\\ -\\{slime-fuzzy-map}" - (use-local-map slime-fuzzy-map)) +\\ +\\{slime-fuzzy-completions-map}" + (use-local-map slime-fuzzy-completions-map)) -(defvar slime-fuzzy-map +(defvar slime-fuzzy-completions-map (let* ((map (make-sparse-keymap))) - (define-key map "q" 'slime-fuzzy-completion-abort) - (define-key map "\r" 'slime-fuzzy-completion-select) + (define-key map "q" 'slime-fuzzy-abort) + (define-key map "\r" 'slime-fuzzy-select) - (define-key map "n" 'slime-fuzzy-completion-next) - (define-key map "\M-n" 'slime-fuzzy-completion-next) + (define-key map "n" 'slime-fuzzy-next) + (define-key map "\M-n" 'slime-fuzzy-next) - (define-key map "p" 'slime-fuzzy-completion-prev) - (define-key map "\M-p" 'slime-fuzzy-completion-prev) + (define-key map "p" 'slime-fuzzy-prev) + (define-key map "\M-p" 'slime-fuzzy-prev) (define-key map "\d" 'scroll-down) (define-key map " " 'scroll-up) - (define-key map [mouse-2] 'slime-fuzzy-completion-click) + (define-key map [mouse-2] 'slime-fuzzy-select/mouse) map) - "Keymap for slime-fuzzy-mode.") + "Keymap for slime-fuzzy-completions-mode.") (defun slime-fuzzy-completions (prefix &optional default-package) "Get the list of sorted completion objects from completing @@ -4107,7 +4112,7 @@ (slime-find-buffer-package) (slime-buffer-package)))))) -(defun slime-fuzzy-completion-selected (prefix completion) +(defun slime-fuzzy-selected (prefix completion) "Tell the connected Lisp that the user selected completion `completion' as the completion for `prefix'." (let ((no-properties (copy-sequence prefix))) @@ -4139,11 +4144,10 @@ ;; Incomplete (t (slime-minibuffer-respecting-message "Complete but not unique") - (slime-fuzzy-completion-choices-buffer completion-set beg end))) - ))) + (slime-fuzzy-choices-buffer completion-set beg end)))))) -(defun get-slime-fuzzy-buffer () +(defun slime-get-fuzzy-buffer () (get-buffer-create "*Fuzzy Completions*")) (defvar slime-fuzzy-explanation @@ -4176,200 +4180,196 @@ (insert "\n") (put-text-property start (point) 'completion completion)))) -(defun slime-fuzzy-completion-click (event) - "Handle a mouse-2 click on a completion choice as if point were -on the completion choice and the slime-fuzzy-completion-select -command was run." - (interactive "e") - (save-excursion - (with-current-buffer (window-buffer (posn-window (event-end event))) - (save-excursion - (goto-char (posn-point (event-end event))) - (when (get-text-property (point) 'mouse-face) - (slime-fuzzy-completion-insert-from-point) - (slime-fuzzy-completion-select)))))) - -(defun slime-fuzzy-completion-insert (text) +(defun slime-fuzzy-insert (text) "Inserts `text' into the target buffer in the completion slot. If the buffer has been modified in the meantime, abort the completion process. Otherwise, update all completion variables so that the new text is present." - (with-current-buffer slime-fuzzy-completion-target-buffer - (when (not (string-equal slime-fuzzy-completion-current - (buffer-substring slime-fuzzy-completion-start - slime-fuzzy-completion-end))) - (slime-fuzzy-completion-done) - ;; Not an error, we may be in the post-command-hook. + (with-current-buffer slime-fuzzy-target-buffer + (cond + ((not (string-equal slime-fuzzy-text + (buffer-substring slime-fuzzy-start + slime-fuzzy-end))) + (slime-fuzzy-done) (beep) (message "Target buffer has been modified!")) - (goto-char slime-fuzzy-completion-end) - (insert-and-inherit text) - (delete-region slime-fuzzy-completion-start slime-fuzzy-completion-end) - (setq slime-fuzzy-completion-end (+ slime-fuzzy-completion-start - (length text))) - (setq slime-fuzzy-completion-current text) - (goto-char slime-fuzzy-completion-end))) + (t + (goto-char slime-fuzzy-start) + (delete-region slime-fuzzy-start slime-fuzzy-end) + (insert-and-inherit text) + (setq slime-fuzzy-text text) + (goto-char slime-fuzzy-end))))) -(defun slime-fuzzy-completion-choices-buffer (completions start end) +(defun slime-fuzzy-choices-buffer (completions start end) "Creates (if neccessary), populates, and pops up the *Fuzzy Completions* buffer with the completions from `completions' and the completion slot in the current buffer bounded by `start' and `end'. This saves the window configuration before popping the buffer so that it can possibly be restored when the user is done." - (remove-hook 'window-configuration-change-hook - 'slime-fuzzy-completion-window-configuration-change) - (setq slime-fuzzy-completion-start start) - (setq slime-fuzzy-completion-end end) - (setq slime-fuzzy-completion-original-text (buffer-substring start end)) - (setq slime-fuzzy-completion-current slime-fuzzy-completion-original-text) - (setq slime-fuzzy-completion-target-buffer (current-buffer)) - (set-buffer (get-slime-fuzzy-buffer)) - (setq buffer-read-only nil) - (erase-buffer) - (slime-fuzzy-mode) - (insert slime-fuzzy-explanation) - (let ((max-length 12)) - (dolist (completion completions) - (setf max-length (max max-length (length (first completion))))) - (insert "Completion:") - (dotimes (i (- max-length 10)) (insert " ")) - (insert "Score:\n") - (dotimes (i max-length) (insert "-")) - (insert " --------\n") - (setq slime-fuzzy-completion-first (point)) - (dolist (completion completions) - (slime-fuzzy-insert-completion-choice completion max-length)) - (setq buffer-read-only t)) - (setq slime-fuzzy-completion-current-completion - (caar completions)) - (slime-fuzzy-completion-insert (caar completions)) - (goto-char slime-fuzzy-completion-first) - (slime-fuzzy-completion-save-window-configuration) - (pop-to-buffer (current-buffer)) - (make-local-variable 'post-command-hook) - (add-hook 'post-command-hook - 'slime-fuzzy-completion-post-command-hook)) + (setq slime-fuzzy-target-buffer (current-buffer)) + (setq slime-fuzzy-target-mtime nil) + (setq slime-fuzzy-start (move-marker (make-marker) start)) + (setq slime-fuzzy-end (move-marker (make-marker) end)) + (set-marker-insertion-type slime-fuzzy-end t) + (setq slime-fuzzy-original-text (buffer-substring start end)) + (setq slime-fuzzy-text slime-fuzzy-original-text) + (slime-fuzzy-save-window-configuration) + (with-current-buffer (slime-get-fuzzy-buffer) + (setq buffer-read-only nil) + (erase-buffer) + (slime-fuzzy-completions-mode) + (insert slime-fuzzy-explanation) + (let ((max-length 12)) + (dolist (completion completions) + (setf max-length (max max-length (length (first completion))))) + (insert "Completion:") + (dotimes (i (- max-length 10)) (insert " ")) + (insert "Score:\n") + (dotimes (i max-length) (insert "-")) + (insert " --------\n") + (setq slime-fuzzy-first (point)) + (dolist (completion completions) + (slime-fuzzy-insert-completion-choice completion max-length)) + (setq buffer-read-only t)) + (setq slime-fuzzy-current-completion + (caar completions)) + (slime-fuzzy-insert (caar completions)) + (goto-char slime-fuzzy-first) + (pop-to-buffer (current-buffer)) + (add-hook (make-local-variable 'post-command-hook) + 'slime-fuzzy-post-command-hook))) -(defun slime-fuzzy-completion-insert-from-point () +(defun slime-fuzzy-insert-from-point () "Inserts the completion that is under point in the completions buffer into the target buffer. If the completion in question had already been inserted, it does nothing." - (with-current-buffer (get-slime-fuzzy-buffer) + (with-current-buffer (slime-get-fuzzy-buffer) (let ((current-completion (get-text-property (point) 'completion))) (when (and current-completion - (not (eq slime-fuzzy-completion-current-completion + (not (eq slime-fuzzy-current-completion current-completion))) - (slime-fuzzy-completion-insert + (slime-fuzzy-insert (first (get-text-property (point) 'completion))) - (setq slime-fuzzy-completion-current-completion + (setq slime-fuzzy-current-completion current-completion))))) -(defun slime-fuzzy-completion-post-command-hook () +(defun slime-fuzzy-post-command-hook () "The post-command-hook for the *Fuzzy Completions* buffer. This makes sure the completion slot in the target buffer matches the completion that point is on in the completions buffer." (condition-case err - (when slime-fuzzy-completion-target-buffer - (slime-fuzzy-completion-insert-from-point)) + (when slime-fuzzy-target-buffer + (slime-fuzzy-insert-from-point)) (error ;; Because this is called on the post-command-hook, we mustn't let ;; errors propagate. - (message "Error in slime-fuzzy-completion-post-command-hook: %S" err)))) + (message "Error in slime-fuzzy-post-command-hook: %S" err)))) -(defun slime-fuzzy-completion-next () +(defun slime-fuzzy-next () "Moves point directly to the next completion in the completions buffer." (interactive) (goto-char (next-single-char-property-change (point) 'completion))) -(defun slime-fuzzy-completion-prev () +(defun slime-fuzzy-prev () "Moves point directly to the previous completion in the completions buffer." (interactive) (goto-char (previous-single-char-property-change (point) 'completion - nil slime-fuzzy-completion-first))) + nil slime-fuzzy-first))) -(defun slime-fuzzy-completion-abort () +(defun slime-fuzzy-abort () "Aborts the completion process, setting the completions slot in the target buffer back to its original contents." (interactive) - (when slime-fuzzy-completion-target-buffer - (slime-fuzzy-completion-insert slime-fuzzy-completion-original-text) - (slime-fuzzy-completion-done))) + (when slime-fuzzy-target-buffer + (slime-fuzzy-insert slime-fuzzy-original-text) + (slime-fuzzy-done))) -(defun slime-fuzzy-completion-select () +(defun slime-fuzzy-select () "Selects the current completion, making sure that it is inserted into the target buffer. This tells the connected Lisp what completion was selected." (interactive) - (when slime-fuzzy-completion-target-buffer - (with-current-buffer (get-slime-fuzzy-buffer) + (when slime-fuzzy-target-buffer + (with-current-buffer (slime-get-fuzzy-buffer) (let ((completion (get-text-property (point) 'completion))) (when completion - (slime-fuzzy-completion-insert (first completion)) - (slime-fuzzy-completion-selected slime-fuzzy-completion-original-text - completion) - (slime-fuzzy-completion-done)))))) + (slime-fuzzy-insert (first completion)) + (slime-fuzzy-selected slime-fuzzy-original-text + completion) + (slime-fuzzy-done)))))) -(defun slime-fuzzy-completion-done () +(defun slime-fuzzy-select/mouse (event) + "Handle a mouse-2 click on a completion choice as if point were +on the completion choice and the slime-fuzzy-select command was +run." + (interactive "e") + (with-current-buffer (window-buffer (posn-window (event-end event))) + (save-excursion + (goto-char (posn-point (event-end event))) + (when (get-text-property (point) 'mouse-face) + (slime-fuzzy-insert-from-point) + (slime-fuzzy-select))))) + +(defun slime-fuzzy-done () "Cleans up after the completion process. This removes all hooks, and attempts to restore the window configuration. If this fails, it just burys the completions buffer and leaves the window configuration alone." - (set-buffer slime-fuzzy-completion-target-buffer) + (set-buffer slime-fuzzy-target-buffer) (remove-hook 'post-command-hook - 'slime-fuzzy-completion-post-command-hook) - (if (slime-fuzzy-completion-maybe-restore-window-configuration) - (bury-buffer (get-slime-fuzzy-buffer)) - ;; We couldn't restore the windows, so just bury the - ;; fuzzy completions buffer and let something else fill - ;; it in. - (pop-to-buffer (get-slime-fuzzy-buffer)) + 'slime-fuzzy-post-command-hook) + (if (slime-fuzzy-maybe-restore-window-configuration) + (bury-buffer (slime-get-fuzzy-buffer)) + ;; We couldn't restore the windows, so just bury the fuzzy + ;; completions buffer and let something else fill it in. + (pop-to-buffer (slime-get-fuzzy-buffer)) (bury-buffer)) - (pop-to-buffer slime-fuzzy-completion-target-buffer) - (goto-char slime-fuzzy-completion-end) - (setq slime-fuzzy-completion-target-buffer nil)) - -(defun slime-fuzzy-completion-save-window-configuration () - "Saves the current window configuration, and sets up for the + (pop-to-buffer slime-fuzzy-target-buffer) + (goto-char slime-fuzzy-end) + (setq slime-fuzzy-target-buffer nil)) + +(defun slime-fuzzy-save-window-configuration () + "Saves the current window configuration, and (if the +window-configuration-change-hook variable exists) sets up for the saved configuration to be nullified if the user changes the window configuration further. Adding the nullification routine to window-configuration-change-hook is delayed so that the windows stabalize before we start listening on the hook." - (setq slime-fuzzy-completion-window-configuration + (setq slime-fuzzy-saved-window-configuration (current-window-configuration)) - (setq slime-fuzzy-completion-window-configuration-change-count 0) - (run-with-timer - 0.5 nil 'slime-fuzzy-completion-window-configuration-change-add-hook)) + (when (boundp 'window-configuration-change-hook) + (run-with-timer + 0.5 nil 'slime-fuzzy-window-configuration-change-add-hook))) -(defun slime-fuzzy-completion-maybe-restore-window-configuration () +(defun slime-fuzzy-maybe-restore-window-configuration () "Restores the saved window configuration if it has not been nullified." - (remove-hook 'window-configuration-change-hook - 'slime-fuzzy-completion-window-configuration-change) - (if (not slime-fuzzy-completion-window-configuration) + (when (boundp 'window-configuration-change-hook) + (remove-hook 'window-configuration-change-hook + 'slime-fuzzy-window-configuration-change)) + (if (not slime-fuzzy-saved-window-configuration) nil - (set-window-configuration slime-fuzzy-completion-window-configuration) - (setq slime-fuzzy-completion-window-configuration nil) + (set-window-configuration slime-fuzzy-saved-window-configuration) + (setq slime-fuzzy-saved-window-configuration nil) t)) -(defun slime-fuzzy-completion-window-configuration-change-add-hook () - "Sets up slime-fuzzy-completion-window-configuration-change on +(defun slime-fuzzy-window-configuration-change-add-hook () + "Sets up slime-fuzzy-window-configuration-change on window-configuration-change-hook." - (remove-hook 'post-command-hook - 'slime-fuzzy-completion-window-configuration-change-add-hook) (add-hook 'window-configuration-change-hook - 'slime-fuzzy-completion-window-configuration-change)) + 'slime-fuzzy-window-configuration-change)) -(defun slime-fuzzy-completion-window-configuration-change () +(defun slime-fuzzy-window-configuration-change () "Called on window-configuration-change-hook. Since the window configuration was changed, we nullify our saved configuration." (remove-hook 'window-configuration-change-hook - 'slime-fuzzy-completion-window-configuration-change) - (setq slime-fuzzy-completion-window-configuration nil)) + 'slime-fuzzy-window-configuration-change) + (setq slime-fuzzy-saved-window-configuration nil)) ;;; Interpreting Elisp symbols as CL symbols (package qualifiers) From bdowning at common-lisp.net Wed Jun 23 22:51:00 2004 From: bdowning at common-lisp.net (Brian Downing) Date: Wed, 23 Jun 2004 15:51:00 -0700 Subject: [slime-cvs] CVS update: slime/doc/slime.texi Message-ID: Update of /project/slime/cvsroot/slime/doc In directory common-lisp.net:/tmp/cvs-serv29908/doc Modified Files: slime.texi Log Message: * slime.el: Re-added most of Luke's patches from yesterday. It has the shortened names, uses markers instead of stored `(point)' values, and `slime-fuzzy-complete-symbol' is an option for `slime-complete-symbol-function'. It still string compares the target buffer instead of using `(buffer-modified-tick)'. I left the `C-c M-i' keybinding in, as it allows use of the regular completion as well. If there's an objection to this it can be removed. `window-configuration-change-hook' is used if the variable is present, and ignored it not. This neatly sidesteps its absence in XEmacs while not killing the functionality for GNU Emacs. * doc/slime.texi: Added a command entry and short description for `C-c M-I, slime-fuzzy-complete-symbol', and added its existence to the `slime-complete-symbol-function' documentation. Date: Wed Jun 23 15:51:00 2004 Author: bdowning Index: slime/doc/slime.texi diff -u slime/doc/slime.texi:1.15 slime/doc/slime.texi:1.16 --- slime/doc/slime.texi:1.15 Wed Jun 23 02:59:58 2004 +++ slime/doc/slime.texi Wed Jun 23 15:51:00 2004 @@ -46,7 +46,7 @@ @end macro @set EDITION DRAFT - at set UPDATED @code{$Id: slime.texi,v 1.15 2004/06/23 09:59:58 asimon Exp $} + at set UPDATED @code{$Id: slime.texi,v 1.16 2004/06/23 22:51:00 bdowning Exp $} @titlepage @title SLIME User Manual @@ -547,10 +547,22 @@ @table @kbd @kbditem{M-TAB, slime-complete-symbol} -Complete the symbol at point. Note that two styles of completion are +Complete the symbol at point. Note that three styles of completion are available in @SLIME{}, and the default differs from normal Emacs completion. @xref{Emacs-side customization}. + at anchor{slime-fuzzy-complete-symbol} + at kbditem{C-c M-i, slime-fuzzy-complete-symbol} +Presents a list of likely completions to choose from for an +abbreviation at point. This is a third completion method and it is +very different from the more traditional completion to which + at command{slime-complete-symbol} defaults. It attempts to complete a +symbol all at once, instead of in pieces. For example, ``mvb'' will +find ``@code{multiple-value-bind}'' and ``norm-df'' will find +``@code{least-positive-normalized-double-float}''. This can also be +selected as the method of completion used for + at code{slime-complete-symbol}. + @kbditem{SPC, slime-space} The space key inserts a space and also looks up and displays the argument list for the function at point, if there is one. @@ -1105,7 +1117,7 @@ on. It can however cause information to spill off the screen. @item slime-complete-symbol-function -The function to use for completion of Lisp symbols. Two completion +The function to use for completion of Lisp symbols. Three completion styles are available. The default @code{slime-complete-symbol*} performs completion ``in parallel'' over the hyphen-delimited sub-words of a symbol name. @@ -1127,8 +1139,12 @@ @item @code{w--stream} completes to @code{with-open-stream}. @end itemize -The alternative is @code{slime-simple-complete-symbol}, which -completes in the usual Emacs way. +An alternative is @code{slime-simple-complete-symbol}, which +completes in the usual Emacs way. Finally, there is + at code{slime-fuzzy-complete-symbol}, which is quite different from both +of the above and tries to find best matches to an abbreviated symbol. +It also has its own keybinding, defaulting to @kbd{C-c M-i}. + at xref{slime-fuzzy-complete-symbol}, for more information. @item slime-multiprocessing This should be set to @code{t} if you want to use multiprocessing From maetialgmdrtd at yahoo.com Thu Jun 24 02:57:18 2004 From: maetialgmdrtd at yahoo.com (Trudy Hurley) Date: Thu, 24 Jun 2004 04:57:18 +0200 Subject: [slime-cvs] Re: Just take a look Message-ID: An HTML attachment was scrubbed... URL: From bdowning at common-lisp.net Thu Jun 24 04:32:18 2004 From: bdowning at common-lisp.net (Brian Downing) Date: Wed, 23 Jun 2004 21:32:18 -0700 Subject: [slime-cvs] CVS update: slime/ChangeLog slime/slime.el Message-ID: Update of /project/slime/cvsroot/slime In directory common-lisp.net:/tmp/cvs-serv16890 Modified Files: ChangeLog slime.el Log Message: * slime.el (slime-repl-send-input): Fixed a subtle difference in sending input to the Lisp introduced in 1.316. The newline was not getting sent, resulting in the Lisp constantly asking for more read data. I believe the code has been adjusted to behave the same as 1.315 with regard to sending newlines. Also adjusted the `slime-repl-old-input' text property to end just before the newline, not just after. This causes a gap between inputs even if no Lisp output appeared in between, so that putting point on an old line and hitting RET will only call up that line, and hitting RET in the middle of the current line will send it and not bring up a confusing combination of all previous input. Many thanks to Loyd Fueston for pinpointing the date and exact patch for when this problem was introduced. Date: Wed Jun 23 21:32:17 2004 Author: bdowning Index: slime/ChangeLog diff -u slime/ChangeLog:1.425 slime/ChangeLog:1.426 --- slime/ChangeLog:1.425 Wed Jun 23 15:50:59 2004 +++ slime/ChangeLog Wed Jun 23 21:32:17 2004 @@ -1,3 +1,19 @@ +2004-06-24 Brian Downing + + * slime.el (slime-repl-send-input): Fixed a subtle difference in + sending input to the Lisp introduced in 1.316. The newline was + not getting sent, resulting in the Lisp constantly asking for more + read data. I believe the code has been adjusted to behave the + same as 1.315 with regard to sending newlines. + Also adjusted the `slime-repl-old-input' text property to end just + before the newline, not just after. This causes a gap between + inputs even if no Lisp output appeared in between, so that putting + point on an old line and hitting RET will only call up that line, + and hitting RET in the middle of the current line will send it and + not bring up a confusing combination of all previous input. + Many thanks to Loyd Fueston for pinpointing the date and exact + patch for when this problem was introduced. + 2004-06-23 Brian Downing * slime.el: Re-added most of Luke's patches from yesterday. It Index: slime/slime.el diff -u slime/slime.el:1.334 slime/slime.el:1.335 --- slime/slime.el:1.334 Wed Jun 23 15:50:59 2004 +++ slime/slime.el Wed Jun 23 21:32:17 2004 @@ -2300,13 +2300,14 @@ If NEWLINE is true then add a newline at the end of the input." (when (< (point) slime-repl-input-start-mark) (error "No input at point.")) + (goto-char slime-repl-input-end-mark) + (add-text-properties slime-repl-input-start-mark (point) + '(face slime-repl-input-face + rear-nonsticky (face) + slime-repl-old-input t)) + (when newline (insert "\n")) (let ((input (slime-repl-current-input))) (goto-char slime-repl-input-end-mark) - (when newline (insert "\n")) - (add-text-properties slime-repl-input-start-mark (point) - '(face slime-repl-input-face - rear-nonsticky (face) - slime-repl-old-input t)) (slime-mark-input-start) (slime-mark-output-start) (slime-repl-send-string input))) From lgorrie at common-lisp.net Thu Jun 24 12:57:09 2004 From: lgorrie at common-lisp.net (Luke Gorrie) Date: Thu, 24 Jun 2004 05:57:09 -0700 Subject: [slime-cvs] CVS update: slime/slime.el Message-ID: Update of /project/slime/cvsroot/slime In directory common-lisp.net:/tmp/cvs-serv10143 Modified Files: slime.el Log Message: (sldb-format-reference-node): fix for when `what' is a list. Date: Thu Jun 24 05:57:09 2004 Author: lgorrie Index: slime/slime.el diff -u slime/slime.el:1.335 slime/slime.el:1.336 --- slime/slime.el:1.335 Wed Jun 23 21:32:17 2004 +++ slime/slime.el Thu Jun 24 05:57:09 2004 @@ -5435,7 +5435,7 @@ (and (eq where :ansi-cl) (symbolp type) (member (slime-cl-symbol-name type) - '("function" "special-operator" "macro")))) + '("function" "special-operator" "macro" "section")))) `(sldb-default-action sldb-lookup-reference sldb-reference ,ref face sldb-reference-face @@ -5450,7 +5450,9 @@ (defun sldb-format-reference-node (what) (if (symbolp what) (upcase (slime-cl-symbol-name what)) - what)) + (if (listp what) + (mapconcat (lambda (x) (format "%S" x)) what ".") + what))) (defun sldb-lookup-reference () "Browse the documentation reference at point." @@ -5458,9 +5460,13 @@ (get-text-property (point) 'sldb-reference) (case where (:ansi-cl - (hyperspec-lookup (if (symbolp what) - (slime-cl-symbol-name what) - what))) + (case type + (:section + (browse-url (funcall common-lisp-hyperspec-section-fun what))) + (t + (hyperspec-lookup (if (symbolp what) + (slime-cl-symbol-name what) + what))))) (t (let ((url (format "%s%s.html" slime-sbcl-manual-root (downcase what)))) (browse-url url)))))) From lgorrie at common-lisp.net Thu Jun 24 13:00:45 2004 From: lgorrie at common-lisp.net (Luke Gorrie) Date: Thu, 24 Jun 2004 06:00:45 -0700 Subject: [slime-cvs] CVS update: slime/hyperspec.el Message-ID: Update of /project/slime/cvsroot/slime In directory common-lisp.net:/tmp/cvs-serv22029 Modified Files: hyperspec.el Log Message: (common-lisp-hyperspec-6.0): generalize to work with section numbers lower than 10. Date: Thu Jun 24 06:00:45 2004 Author: lgorrie Index: slime/hyperspec.el diff -u slime/hyperspec.el:1.2 slime/hyperspec.el:1.3 --- slime/hyperspec.el:1.2 Thu Dec 4 08:42:53 2003 +++ slime/hyperspec.el Thu Jun 24 06:00:45 2004 @@ -1124,7 +1124,10 @@ (defun common-lisp-hyperspec-section-6.0 (indices) (let ((string (format "%sBody/%s_" common-lisp-hyperspec-root - (pop indices)))) + (let ((base (pop indices))) + (if (< base 10) + (format "0%s" base) + base))))) (concat string (mapconcat (lambda (n) (make-string 1 (+ ?a (- n 1)))) From lgorrie at common-lisp.net Thu Jun 24 13:01:05 2004 From: lgorrie at common-lisp.net (Luke Gorrie) Date: Thu, 24 Jun 2004 06:01:05 -0700 Subject: [slime-cvs] CVS update: slime/ChangeLog Message-ID: Update of /project/slime/cvsroot/slime In directory common-lisp.net:/tmp/cvs-serv22817 Modified Files: ChangeLog Log Message: Date: Thu Jun 24 06:01:05 2004 Author: lgorrie Index: slime/ChangeLog diff -u slime/ChangeLog:1.426 slime/ChangeLog:1.427 --- slime/ChangeLog:1.426 Wed Jun 23 21:32:17 2004 +++ slime/ChangeLog Thu Jun 24 06:01:04 2004 @@ -1,3 +1,13 @@ +2004-06-24 Christophe Rhodes + + * slime.el (sldb-format-reference-node): fix for when `what' is a + list. + (sldb-lookup-reference,sldb-reference-properties): support + :ansi-cl :section reference types. + + * hyperspec.el (common-lisp-hyperspec-6.0): generalize to work + with section numbers lower than 10. + 2004-06-24 Brian Downing * slime.el (slime-repl-send-input): Fixed a subtle difference in From fqredlmsjq at msn.com Thu Jun 24 21:42:39 2004 From: fqredlmsjq at msn.com (Ada Anderson) Date: Thu, 24 Jun 2004 19:42:39 -0200 Subject: [slime-cvs] Prescription Meds Prescribed For Free Online Message-ID: An HTML attachment was scrubbed... URL: From EFQEOMEVBJM at rbg.informatik.tu-darmstadt.de Thu Jun 24 22:12:46 2004 From: EFQEOMEVBJM at rbg.informatik.tu-darmstadt.de (Lorna Ouellette) Date: Fri, 25 Jun 2004 00:12:46 +0200 Subject: [slime-cvs] universitty degres for sale! Message-ID: An HTML attachment was scrubbed... URL: From kathlinetrisler at maktoob.com Thu Jun 24 20:45:36 2004 From: kathlinetrisler at maktoob.com (agustin wydner) Date: Thu, 24 Jun 2004 15:45:36 -0500 Subject: [slime-cvs] Ijuli You can 0rder PAIN M.edS, Anti-Depressants, weightloss M.eds on1ine Message-ID: <0483C937.CF3D199@maktoob.com> dinnmrn folgenden cuttst We are your your convenient, safe and private online source for FDA a`p`p`roved pharmacy prescriptions. X at n`ax --V at 1ium-- right to your door. Go to our site for more information, so we can help you with all your prescription needs. Q E http://gnrcp.nin.olympus8924biz.us/f74/ At Sunday School they were teaching how God created everything, including human beings. Little Tommy, a child in??the kindergarten class, seemed especially intent when they told him how Eve was created out of one of Adam's ribs.Later in the week his mother noticed him lying down as though he were ill, and asked, "Tommy, what's the matter?"Little Tommy responded, "I have a pain in my side. I think I'm gonna have a wife." A man and a woman walk into a very posh Rodeo Drive store. "Show the lady your finest mink!" the fellow exclaims. So the owner of the shop goes in back and comes out with an absolutely gorgeous full-length coat. As the lady tries it on, the owner discreetly whispers to the man, "Ah, sir, that particular fur goes for $65,000." "No problem! I'll write you a check!" "Very good, sir." says the shop owner. "Today is Saturday. You may come by on Monday to pick it up, after the check has cleared." So the man and the woman leave. On Monday, the fellow returns. The store owner is outraged, "How dare you show your face in here?! There wasn't a single penny in your checking account!!""I just had to come by," grinned the guy, "to thank you for the most wonderful weekend of my life!" turi-0tikuzenu68seisikik,simizumi sodai. From dknpeiwf at direcpc.com Fri Jun 25 02:33:57 2004 From: dknpeiwf at direcpc.com (Carrie Bishop) Date: Fri, 25 Jun 2004 07:33:57 +0500 Subject: [slime-cvs] Get All Meds. Any Meds You Want Prescriptions Written and Filled Online. Message-ID: <%RNDUCCHAR2025@velocitus.net> An HTML attachment was scrubbed... URL: From heller at common-lisp.net Fri Jun 25 08:04:39 2004 From: heller at common-lisp.net (Helmut Eller) Date: Fri, 25 Jun 2004 01:04:39 -0700 Subject: [slime-cvs] CVS update: slime/slime.el Message-ID: Update of /project/slime/cvsroot/slime In directory common-lisp.net:/tmp/cvs-serv2647 Modified Files: slime.el Log Message: (sldb-insert-condition): Initialize sldb-default-action so that pressing RET inspects the condition. (slime-repl-insert-prompt): Set defun-promp-regexp. beginning-of-defun can be very slow in the repl buffer if the defun-promp-regexp is not set. (sldb-insert-locals): Initialize sldb-default-action. (sldb-var-number-at-point, sldb-inspect-var): New function. Date: Fri Jun 25 01:04:39 2004 Author: heller Index: slime/slime.el diff -u slime/slime.el:1.336 slime/slime.el:1.337 --- slime/slime.el:1.336 Thu Jun 24 05:57:09 2004 +++ slime/slime.el Fri Jun 25 01:04:38 2004 @@ -244,6 +244,7 @@ ;; '(slime-inspector-topline-face ((t (:foreground "brown" :weight bold :height 1.2)))) ;; '(slime-inspector-type-face ((t (:foreground "DarkRed" :weight bold)))) + ;;;;; sldb (defgroup slime-debugger nil @@ -2117,7 +2118,8 @@ (unless (bolp) (insert "\n")) (slime-insert-propertized '(face slime-repl-result-face) result) (unless (bolp) (insert "\n")) - (let ((prompt-start (point))) + (let ((prompt-start (point)) + (prompt (format "%s> " (slime-lisp-package)))) (slime-propertize-region '(face slime-repl-prompt-face read-only t @@ -2127,7 +2129,8 @@ rear-nonsticky (slime-repl-prompt read-only face intangible) ;; xemacs stuff start-open t end-open t) - (insert (slime-lisp-package) "> ")) + (insert prompt)) + (setq defun-prompt-regexp prompt) (set-marker slime-output-end start) (set-marker slime-repl-prompt-start-mark prompt-start) (slime-mark-input-start) @@ -5407,10 +5410,11 @@ (defun sldb-insert-condition (condition) (destructuring-bind (message type references) condition - (insert (in-sldb-face topline message) - "\n" - (in-sldb-face condition type) - "\n\n") + (slime-insert-propertized '(sldb-default-action sldb-inspect-condition) + (in-sldb-face topline message) + "\n" + (in-sldb-face condition type) + "\n\n") (when references (insert "See also:\n") (slime-with-rigid-indentation 2 @@ -5573,6 +5577,11 @@ (cond (frame (car frame)) (t (error "No frame at point"))))) +(defun sldb-var-number-at-point () + (let ((var (get-text-property (point) 'var))) + (cond (var var) + (t (error "No variable at point"))))) + (defun sldb-previous-frame-number () (save-excursion (sldb-backward-frame) @@ -5776,12 +5785,23 @@ (slime-eval `(swank:frame-locals-for-emacs ,frame))) (defun sldb-insert-locals (frame prefix) - (dolist (var (sldb-frame-locals frame)) - (destructuring-bind (&key name id value) var - (insert prefix (in-sldb-face local-name name)) - (unless (zerop id) - (insert (in-sldb-face local-name (format "#%d" id)))) - (insert " = " (in-sldb-face local-value value) "\n")))) + (loop for i from 0 + for var in (sldb-frame-locals frame) do + (destructuring-bind (&key name id value) var + (slime-propertize-region (list 'sldb-default-action 'sldb-inspect-var + 'var i) + (insert prefix (in-sldb-face local-name name)) + (unless (zerop id) + (insert (in-sldb-face local-name (format "#%d" id)))) + (insert " = " (in-sldb-face local-value value))) + (insert "\n")))) + +(defun sldb-inspect-var () + (let ((frame (sldb-frame-number-at-point)) + (var (sldb-var-number-at-point))) + (slime-eval-async `(swank:inspect-frame-var ,frame ,var) + (slime-buffer-package) + 'slime-open-inspector))) (defun sldb-list-locals () "List local variables in selected frame." From heller at common-lisp.net Fri Jun 25 08:05:21 2004 From: heller at common-lisp.net (Helmut Eller) Date: Fri, 25 Jun 2004 01:05:21 -0700 Subject: [slime-cvs] CVS update: slime/swank-allegro.lisp Message-ID: Update of /project/slime/cvsroot/slime In directory common-lisp.net:/tmp/cvs-serv4377 Modified Files: swank-allegro.lisp Log Message: (frame-var-value): New backend function. Date: Fri Jun 25 01:05:21 2004 Author: heller Index: slime/swank-allegro.lisp diff -u slime/swank-allegro.lisp:1.38 slime/swank-allegro.lisp:1.39 --- slime/swank-allegro.lisp:1.38 Mon Jun 21 23:24:48 2004 +++ slime/swank-allegro.lisp Fri Jun 25 01:05:21 2004 @@ -55,9 +55,12 @@ (princ-to-string c)) (defimplementation condition-references (c) - (declare (ignore)) + (declare (ignore c)) '()) +(defimplementation call-with-syntax-hooks (fn) + (funcall fn)) + ;;;; Unix signals (defimplementation call-without-interrupts (fn) @@ -77,9 +80,6 @@ (defimplementation default-directory () (excl:chdir)) -(defimplementation call-with-syntax-hooks (fn) - (funcall fn)) - ;;;; Misc (defimplementation arglist (symbol) @@ -147,6 +147,10 @@ :id 0 :value (debugger:frame-var-value frame i))))) +(defimplementation frame-var-value (frame var) + (let ((frame (nth-frame frame))) + (debugger:frame-var-value frame var))) + (defimplementation frame-catch-tags (index) (declare (ignore index)) nil) From heller at common-lisp.net Fri Jun 25 08:05:26 2004 From: heller at common-lisp.net (Helmut Eller) Date: Fri, 25 Jun 2004 01:05:26 -0700 Subject: [slime-cvs] CVS update: slime/swank-backend.lisp Message-ID: Update of /project/slime/cvsroot/slime In directory common-lisp.net:/tmp/cvs-serv4886 Modified Files: swank-backend.lisp Log Message: (frame-var-value): New backend function. Date: Fri Jun 25 01:05:26 2004 Author: heller Index: slime/swank-backend.lisp diff -u slime/swank-backend.lisp:1.56 slime/swank-backend.lisp:1.57 --- slime/swank-backend.lisp:1.56 Mon Jun 21 23:24:17 2004 +++ slime/swank-backend.lisp Fri Jun 25 01:05:25 2004 @@ -347,11 +347,16 @@ DEFINE-DEBUGGER-HOOK.") (definterface frame-locals (frame-number) - "Return a list of XXX local variable designators define me + "Return a list of XXX local variable designators define me for a debugger stack frame. The results are undefined unless this is called within the dynamic contour of a function defined by DEFINE-DEBUGGER-HOOK.") +(definterface frame-var-value (frame var) + "Return the value of VAR in FRAME. +FRAME is the number of the frame in the backtrace. +VAR is the number of the variable in the frame.") + (definterface disassemble-frame (frame-number) "Disassemble the code for the FRAME-NUMBER. The output should be written to standard output. @@ -510,12 +515,13 @@ ;;;; Inspector -(defstruct (unbound-slot-filler - (:print-object - (lambda (obj stream) - (print-unreadable-object (obj stream :type t))))) +(defstruct (unbound-slot-filler (:print-function print-unbound-slot)) "The definition of an object which serves as a placeholder in an unbound slot for inspection purposes.") + +(defun print-unbound-slot (o stream depth) + (declare (ignore depth)) + (print-unreadable-object (o stream :type t))) (definterface inspected-parts (object) "Return a short description and a list of (LABEL . VALUE) pairs." From heller at common-lisp.net Fri Jun 25 08:05:30 2004 From: heller at common-lisp.net (Helmut Eller) Date: Fri, 25 Jun 2004 01:05:30 -0700 Subject: [slime-cvs] CVS update: slime/swank-clisp.lisp Message-ID: Update of /project/slime/cvsroot/slime In directory common-lisp.net:/tmp/cvs-serv5078 Modified Files: swank-clisp.lisp Log Message: (frame-var-value): New backend function. Date: Fri Jun 25 01:05:29 2004 Author: heller Index: slime/swank-clisp.lisp diff -u slime/swank-clisp.lisp:1.32 slime/swank-clisp.lisp:1.33 --- slime/swank-clisp.lisp:1.32 Sun May 16 17:25:24 2004 +++ slime/swank-clisp.lisp Fri Jun 25 01:05:29 2004 @@ -25,7 +25,7 @@ (in-package :swank-backend) (eval-when (:compile-toplevel :load-toplevel :execute) - (use-package "SOCKET") + ;;(use-package "SOCKET") (use-package "GRAY")) (eval-when (:compile-toplevel :execute) @@ -197,6 +197,9 @@ (frame-do-benv frame (svref frame-env 2)) (frame-do-genv frame (svref frame-env 3)) (frame-do-denv frame (svref frame-env 4))))) + +(defimplementation frame-var-value (frame var) + (getf (nth var (frame-locals frame)) :value)) ;; Interpreter-Variablen-Environment has the shape ;; NIL or #(v1 val1 ... vn valn NEXT-ENV). From heller at common-lisp.net Fri Jun 25 08:05:34 2004 From: heller at common-lisp.net (Helmut Eller) Date: Fri, 25 Jun 2004 01:05:34 -0700 Subject: [slime-cvs] CVS update: slime/swank-cmucl.lisp Message-ID: Update of /project/slime/cvsroot/slime In directory common-lisp.net:/tmp/cvs-serv5208 Modified Files: swank-cmucl.lisp Log Message: (frame-var-value): New backend function. Date: Fri Jun 25 01:05:34 2004 Author: heller Index: slime/swank-cmucl.lisp diff -u slime/swank-cmucl.lisp:1.107 slime/swank-cmucl.lisp:1.108 --- slime/swank-cmucl.lisp:1.107 Wed Jun 16 13:25:25 2004 +++ slime/swank-cmucl.lisp Fri Jun 25 01:05:34 2004 @@ -1,5 +1,7 @@ ;;; -*- indent-tabs-mode: nil; outline-regexp: ";;;;+" -*- ;;; +;;; License: Public Domain +;;; ;;;; Introduction ;;; ;;; This is the CMUCL implementation of the `swank-backend' package. @@ -521,7 +523,7 @@ "Return FUNCTION's callers. The result is a list of code-objects." (let ((referrers '())) (declare (inline map-caller-code-components)) - (ext:gc :full t) + ;;(ext:gc :full t) (map-caller-code-components function spaces (lambda (code) (push code referrers))) referrers)) @@ -1466,19 +1468,28 @@ (defimplementation eval-in-frame (form index) (di:eval-in-frame (nth-frame index) form)) +(defun frame-debug-vars (frame) + "Return a vector of debug-variables in frame." + (di::debug-function-debug-variables (di:frame-debug-function frame))) + +(defun debug-var-value (var frame location) + (ecase (di:debug-variable-validity var location) + (:valid (di:debug-variable-value var frame)) + ((:invalid :unknown) ':))) + (defimplementation frame-locals (index) (let* ((frame (nth-frame index)) - (location (di:frame-code-location frame)) - (debug-function (di:frame-debug-function frame)) - (debug-variables (di::debug-function-debug-variables debug-function))) - (loop for v across debug-variables collect + (loc (di:frame-code-location frame)) + (vars (frame-debug-vars frame))) + (loop for v across vars collect (list :name (di:debug-variable-symbol v) :id (di:debug-variable-id v) - :value (ecase (di:debug-variable-validity v location) - (:valid - (di:debug-variable-value v frame)) - ((:invalid :unknown) - ':not-available)))))) + :value (debug-var-value v frame loc))))) + +(defimplementation frame-var-value (frame var) + (let* ((frame (nth-frame frame)) + (dvar (aref (frame-debug-vars frame) var))) + (debug-var-value dvar frame (di:frame-code-location frame)))) (defimplementation frame-catch-tags (index) (mapcar #'car (di:frame-catches (nth-frame index)))) From heller at common-lisp.net Fri Jun 25 08:05:38 2004 From: heller at common-lisp.net (Helmut Eller) Date: Fri, 25 Jun 2004 01:05:38 -0700 Subject: [slime-cvs] CVS update: slime/swank-lispworks.lisp Message-ID: Update of /project/slime/cvsroot/slime In directory common-lisp.net:/tmp/cvs-serv5398 Modified Files: swank-lispworks.lisp Log Message: (frame-var-value): New backend function. Date: Fri Jun 25 01:05:38 2004 Author: heller Index: slime/swank-lispworks.lisp diff -u slime/swank-lispworks.lisp:1.46 slime/swank-lispworks.lisp:1.47 --- slime/swank-lispworks.lisp:1.46 Thu Jun 17 08:59:46 2004 +++ slime/swank-lispworks.lisp Fri Jun 25 01:05:38 2004 @@ -239,18 +239,24 @@ (frame-actual-args frame))) (t (princ frame stream)))) +(defun frame-vars (frame) + (first (dbg::frame-locals-format-list frame #'list 75 0))) + (defimplementation frame-locals (n) (let ((frame (nth-frame n))) (if (dbg::call-frame-p frame) - (destructuring-bind (vars with) - (dbg::frame-locals-format-list frame #'list 75 0) - (declare (ignore with)) - (mapcar (lambda (var) - (destructuring-bind (name value symbol location) var - (declare (ignore name location)) - (list :name symbol :id 0 - :value value))) - vars))))) + (mapcar (lambda (var) + (destructuring-bind (name value symbol location) var + (declare (ignore name location)) + (list :name symbol :id 0 + :value value))) + (frame-vars frame))))) + +(defimplementation frame-var-value (frame var) + (let ((frame (nth-frame frame))) + (destructuring-bind (_n value _s _l) (nth var (frame-vars frame)) + (declare (ignore _n _s _l)) + value))) (defimplementation frame-catch-tags (index) (declare (ignore index)) From heller at common-lisp.net Fri Jun 25 08:06:20 2004 From: heller at common-lisp.net (Helmut Eller) Date: Fri, 25 Jun 2004 01:06:20 -0700 Subject: [slime-cvs] CVS update: slime/swank-sbcl.lisp Message-ID: Update of /project/slime/cvsroot/slime In directory common-lisp.net:/tmp/cvs-serv6122 Modified Files: swank-sbcl.lisp Log Message: (call-with-syntax-hooks, with-debootstrapping): Preserve compatability with fairly recent SBCLs by checking for the presense of the debootstrapping facilities at macroexpansion time. Date: Fri Jun 25 01:06:20 2004 Author: heller Index: slime/swank-sbcl.lisp diff -u slime/swank-sbcl.lisp:1.91 slime/swank-sbcl.lisp:1.92 --- slime/swank-sbcl.lisp:1.91 Sun Jun 20 14:37:05 2004 +++ slime/swank-sbcl.lisp Fri Jun 25 01:06:20 2004 @@ -502,20 +502,28 @@ (safe-source-location-for-emacs (sb-di:frame-code-location (nth-frame index)))) +(defun frame-debug-vars (frame) + "Return a vector of debug-variables in frame." + (sb-di::debug-fun-debug-vars (sb-di:frame-debug-fun frame))) + +(defun debug-var-value (var frame location) + (ecase (sb-di:debug-var-validity var location) + (:valid (sb-di:debug-var-value var frame)) + ((:invalid :unknown) ':))) + (defimplementation frame-locals (index) (let* ((frame (nth-frame index)) - (location (sb-di:frame-code-location frame)) - (debug-function (sb-di:frame-debug-fun frame)) - (debug-variables (sb-di::debug-fun-debug-vars debug-function))) - (declare (type (or null simple-vector) debug-variables)) - (loop for v across debug-variables - collect (list - :name (sb-di:debug-var-symbol v) - :id (sb-di:debug-var-id v) - :value (if (eq (sb-di:debug-var-validity v location) - :valid) - (sb-di:debug-var-value v frame) - '#:))))) + (loc (sb-di:frame-code-location frame)) + (vars (frame-debug-vars frame))) + (loop for v across vars collect + (list :name (sb-di:debug-var-symbol v) + :id (sb-di:debug-var-id v) + :value (debug-var-value v frame loc))))) + +(defimplementation frame-var-value (frame var) + (let* ((frame (nth-frame frame)) + (dvar (aref (frame-debug-vars frame) var))) + (debug-var-value dvar frame (sb-di:frame-code-location frame)))) (defimplementation frame-catch-tags (index) (mapcar #'car (sb-di:frame-catches (nth-frame index)))) @@ -704,12 +712,17 @@ (defvar *debootstrap-packages* t) +(defmacro with-debootstrapping (&body body) + (let ((not-found (find-symbol "BOOTSTRAP-PACKAGE-NOT-FOUND" "SB-INT")) + (debootstrap (find-symbol "DEBOOTSTRAP-PACKAGE" "SB-INT"))) + (if (and not-found debootstrap) + `(handler-bind ((,not-found #',debootstrap)) , at body) + `(progn , at body)))) + (defimplementation call-with-syntax-hooks (fn) (cond ((and *debootstrap-packages* (sbcl-package-p *package*)) - (handler-bind ((sb-int:bootstrap-package-not-found - #'sb-int:debootstrap-package)) - (funcall fn))) + (with-debootstrapping (funcall fn))) (t (funcall fn)))) From heller at common-lisp.net Fri Jun 25 08:06:39 2004 From: heller at common-lisp.net (Helmut Eller) Date: Fri, 25 Jun 2004 01:06:39 -0700 Subject: [slime-cvs] CVS update: slime/swank.lisp Message-ID: Update of /project/slime/cvsroot/slime In directory common-lisp.net:/tmp/cvs-serv6700 Modified Files: swank.lisp Log Message: (inspect-frame-var): New function. Date: Fri Jun 25 01:06:39 2004 Author: heller Index: slime/swank.lisp diff -u slime/swank.lisp:1.202 slime/swank.lisp:1.203 --- slime/swank.lisp:1.202 Tue Jun 22 01:02:15 2004 +++ slime/swank.lisp Fri Jun 25 01:06:39 2004 @@ -906,7 +906,7 @@ (defslimefun connection-info () "Return a list of the form: -\(VERSION PID IMPLEMENTATION-TYPE IMPLEMENTATION-NAME FEATURES)." +\(PID IMPLEMENTATION-TYPE IMPLEMENTATION-NAME FEATURES)." (list (getpid) (lisp-implementation-type) (lisp-implementation-type-name) @@ -1578,7 +1578,7 @@ ;;;; Completion (defun determine-case (string) - "Return to booleans LOWER and UPPER indicating whether STRING + "Return two booleans LOWER and UPPER indicating whether STRING contains lower or upper case characters." (values (some #'lower-case-p string) (some #'upper-case-p string))) @@ -2446,26 +2446,27 @@ (inspect-object (eval (read-from-string string))))) (defun print-part-to-string (value) - (let ((*print-pretty* nil) - (*print-circle* t)) - (let ((string (to-string value)) - (pos (position value *inspector-history*))) - (if pos - (format nil "#~D=~A" pos string) - string)))) + (let ((string (to-string value)) + (pos (position value *inspector-history*))) + (if pos + (format nil "#~D=~A" pos string) + string))) (defun inspect-object (object) (push (setq *inspectee* object) *inspector-stack*) (unless (find object *inspector-history*) (vector-push-extend object *inspector-history*)) - (multiple-value-bind (text parts) (inspected-parts object) - (setq *inspectee-parts* parts) - (list :text text - :type (to-string (type-of object)) - :primitive-type (describe-primitive-type object) - :parts (loop for (label . value) in parts - collect (cons (princ-to-string label) - (print-part-to-string value)))))) + (let ((*print-pretty* nil) ; print everything in the same line + (*print-circle* t) + (*print-readably* nil)) + (multiple-value-bind (text parts) (inspected-parts object) + (setq *inspectee-parts* parts) + (list :text text + :type (to-string (type-of object)) + :primitive-type (describe-primitive-type object) + :parts (loop for (label . value) in parts + collect (cons (princ-to-string label) + (print-part-to-string value))))))) (defun nth-part (index) (cdr (nth index *inspectee-parts*))) @@ -2560,6 +2561,11 @@ (with-buffer-syntax () (reset-inspector) (inspect-object *swank-debugger-condition*))) + +(defslimefun inspect-frame-var (frame var) + (with-buffer-syntax () + (reset-inspector) + (inspect-object (frame-var-value frame var)))) ;;;; Thread listing From heller at common-lisp.net Fri Jun 25 08:07:15 2004 From: heller at common-lisp.net (Helmut Eller) Date: Fri, 25 Jun 2004 01:07:15 -0700 Subject: [slime-cvs] CVS update: slime/ChangeLog Message-ID: Update of /project/slime/cvsroot/slime In directory common-lisp.net:/tmp/cvs-serv8230 Modified Files: ChangeLog Log Message: *** empty log message *** Date: Fri Jun 25 01:07:15 2004 Author: heller Index: slime/ChangeLog diff -u slime/ChangeLog:1.427 slime/ChangeLog:1.428 --- slime/ChangeLog:1.427 Thu Jun 24 06:01:04 2004 +++ slime/ChangeLog Fri Jun 25 01:07:14 2004 @@ -1,3 +1,27 @@ +2004-06-25 Thomas F. Burdick + + * swank-sbcl.lisp (call-with-syntax-hooks, with-debootstrapping): + Preserve compatability with fairly recent SBCLs by checking for + the presense of the debootstrapping facilities at macroexpansion + time. + + * slime.el (sldb-insert-condition): Initialize sldb-default-action + so that pressing RET inspects the condition. + +2004-06-25 Helmut Eller + + * slime.el (slime-repl-insert-prompt): Set defun-promp-regexp. + beginning-of-defun can be very slow in the repl buffer if the + defun-promp-regexp is not set. + (sldb-insert-locals): Initialize sldb-default-action. + (sldb-var-number-at-point, sldb-inspect-var): New function. + + * swank.lisp (inspect-frame-var): New function. + + * swank-backend, swank-cmucl.lisp, swank-sbcl.lisp, + swank-allegro.lisp, swank-lispworks.lisp, swank-clisp.lisp + (frame-var-value): New backend function. + 2004-06-24 Christophe Rhodes * slime.el (sldb-format-reference-node): fix for when `what' is a From heller at common-lisp.net Fri Jun 25 10:13:41 2004 From: heller at common-lisp.net (Helmut Eller) Date: Fri, 25 Jun 2004 03:13:41 -0700 Subject: [slime-cvs] CVS update: slime/ChangeLog Message-ID: Update of /project/slime/cvsroot/slime In directory common-lisp.net:/tmp/cvs-serv23867 Modified Files: ChangeLog Log Message: *** empty log message *** Date: Fri Jun 25 03:13:40 2004 Author: heller Index: slime/ChangeLog diff -u slime/ChangeLog:1.428 slime/ChangeLog:1.429 --- slime/ChangeLog:1.428 Fri Jun 25 01:07:14 2004 +++ slime/ChangeLog Fri Jun 25 03:13:40 2004 @@ -10,9 +10,9 @@ 2004-06-25 Helmut Eller - * slime.el (slime-repl-insert-prompt): Set defun-promp-regexp. + * slime.el (slime-repl-insert-prompt): Set defun-prompt-regexp. beginning-of-defun can be very slow in the repl buffer if the - defun-promp-regexp is not set. + defun-prompt-regexp is not set. (sldb-insert-locals): Initialize sldb-default-action. (sldb-var-number-at-point, sldb-inspect-var): New function. From setan at tab-archive.com Sat Jun 26 12:18:47 2004 From: setan at tab-archive.com (gene schwab) Date: Sat, 26 Jun 2004 10:18:47 -0200 Subject: [slime-cvs] Nuoe Ever Wanted p a i n Pills?? 0vernite Shipping To Your D00r Message-ID: klapsigaar klantenwerver aanvangsreactantie 1nternet Pharmacy & Overnight Shipping! Order these pills: ; ^ So+m+a > P/n/termin < V/a/lium . XAN at X Make it easy for you to order meeds. O W http://okcjq.wb.52xsx.com/29/ On Clinton's last trip to Hawaii, he went swimming at Waikiki Beach. He got caught in a riptide and was been pulled out to sea. Three young surfers swam out to him and brought him to shore. He wanted to reward them, and asked what they would like. The first said he wanted to be a fighter pilot, and Clinton said he would get him an appointment to the A. F. Academy. The second one said he wanted to command a submarine. "Fine, I'll get you into the Naval Academy." The third said he wanted to be buried at Arlington. Clinton looked puzzled and asked why such a young person was concerned about where he would be buried. "Because", said the surfer, "my father is a Vietnam Veteran, and when I go home and tell him I saved your life, he's going to kill me." A drunk decides to go ice fishing, so he gathers his gear and goes walking around until he finds a big patch of ice. He heads into the center of the ice and begins to saw a hole. All of sudden, a loud booming voice comes out of the sky. "You will find no fish under that ice." The drunk looks around, but sees no one. He starts sawing again. Once more, the voice speaks, "As I said before, there are no fish under the ice." The drunk looks all around, high and low, but can't see a single soul. He picks up the saw and tries one more time to finish. Before he can even start cutting, the huge voice interrupts. "I have warned you three times now. There are no fish!" The drunk is now flustered and somewhat scared, so he asks the voice, "How do you know there are no fish? Are you God trying to warn me?" "No", the voice replied. "I am the manager of this hockey area! a\ublado0alivio68azabachada,delantealtar baboso. From heller at common-lisp.net Sun Jun 27 06:57:25 2004 From: heller at common-lisp.net (Helmut Eller) Date: Sat, 26 Jun 2004 23:57:25 -0700 Subject: [slime-cvs] CVS update: slime/slime.el Message-ID: Update of /project/slime/cvsroot/slime In directory common-lisp.net:/tmp/cvs-serv10293 Modified Files: slime.el Log Message: (sldb-get-buffer): Add support for multiple sldb buffers for different threads. Update callers accordingly. (sldb-find-buffer, sldb-get-default-buffer): New functions. Date: Sat Jun 26 23:57:25 2004 Author: heller Index: slime/slime.el diff -u slime/slime.el:1.337 slime/slime.el:1.338 --- slime/slime.el:1.337 Fri Jun 25 01:04:38 2004 +++ slime/slime.el Sat Jun 26 23:57:25 2004 @@ -1552,17 +1552,22 @@ (t (error "Unexpected reply: %S %S" id value))))) ((:debug-activate thread level) + (assert thread) (sldb-activate thread level)) ((:debug thread level condition restarts frames) + (assert thread) (sldb-setup thread level condition restarts frames)) ((:debug-return thread level) + (assert thread) (sldb-exit thread level)) ((:emacs-interrupt thread) (cond ((slime-use-sigint-for-interrupt) (slime-send-sigint)) (t (slime-send `(:emacs-interrupt ,thread))))) ((:read-string thread tag) + (assert thread) (slime-repl-read-string thread tag)) ((:read-aborted thread tag) + (assert thread) (slime-repl-abort-read thread tag)) ((:emacs-return-string thread tag string) (slime-send `(:emacs-return-string ,thread ,tag ,string))) @@ -1582,15 +1587,13 @@ ((:ed what) (slime-ed what)) ((:debug-condition thread message) - (apply 'ignore thread) ; XEmacs warns about unused variable + (assert thread) (message "%s" message))))) (defun slime-reset () "Clear all pending continuations." (interactive) - (setq slime-rex-continuations '()) - (when-let (sldb (sldb-get-buffer)) - (kill-buffer sldb))) + (setq slime-rex-continuations '())) (defun slime-nyi () (error "Not yet implemented!")) @@ -5351,13 +5354,27 @@ ;;;;; SLDB buffer creation & update (defvar sldb-overlays '() - "Overlays created in source code buffers to temporarily highlight expressions.") + "List of overlays created in source code buffers to highlight expressions.") + +(defvar sldb-buffers '() + "List of sldb-buffers.") -(defun sldb-get-buffer (&optional create) - (let* ((number (slime-connection-number)) - (buffer-name (format "*sldb [connection #%S]*" number))) - (funcall (if create #'get-buffer-create #'get-buffer) - buffer-name))) +(defun sldb-find-buffer (thread) + (cdr (assoc* (cons (slime-connection) thread) + sldb-buffers + :test #'equal))) + +(defun sldb-get-default-buffer () + (cdr (first sldb-buffers))) + +(defun sldb-get-buffer (thread) + (or (sldb-find-buffer thread) + (let* ((name (slime-connection-name)) + (buffer-name (format "*sldb [%s/%s]*" name thread)) + (buffer (get-buffer-create buffer-name))) + (push (cons (cons (slime-connection) thread) buffer) + sldb-buffers) + buffer))) (defun sldb-setup (thread level condition restarts frames) "Setup a new SLDB buffer. @@ -5365,7 +5382,7 @@ 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." - (with-current-buffer (sldb-get-buffer t) + (with-current-buffer (sldb-get-buffer thread) (unless (equal sldb-level level) (setq buffer-read-only nil) (sldb-mode) @@ -5390,7 +5407,7 @@ (recursive-edit))))) (defun sldb-activate (thread level) - (with-current-buffer (sldb-get-buffer t) + (with-current-buffer (sldb-find-buffer thread) (unless (equal sldb-level level) (with-lexical-bindings (thread level) (slime-eval-async `(swank:debugger-info-for-emacs 0 1) nil @@ -5399,13 +5416,14 @@ ;; XXX thread is ignored (defun sldb-exit (thread level) - (when-let (sldb (sldb-get-buffer)) + (when-let (sldb (sldb-find-buffer thread)) (with-current-buffer sldb (set-window-configuration sldb-saved-window-configuration) (let ((inhibit-read-only t)) (erase-buffer)) (setq sldb-level nil)) (when (= level 1) + (setf sldb-buffers (remove* sldb sldb-buffers :key #'cdr)) (kill-buffer sldb)))) (defun sldb-insert-condition (condition) @@ -6263,9 +6281,9 @@ (def-slime-selector-method ?d "the *sldb* buffer for the current connection." - (unless (sldb-get-buffer) + (unless (sldb-get-default-buffer) (error "No debugger buffer")) - (sldb-get-buffer)) + (sldb-get-default-buffer)) (def-slime-selector-method ?e "the most recently visited emacs-lisp-mode buffer." @@ -6695,7 +6713,7 @@ (slime-at-top-level-p))) (defun slime-at-top-level-p () - (and (null (sldb-get-buffer)) + (and (not (sldb-get-default-buffer)) (null slime-rex-continuations))) (defun slime-wait-condition (name predicate timeout) @@ -6710,7 +6728,7 @@ (slime-wait-condition "top-level" #'slime-at-top-level-p timeout)) (defun slime-check-sldb-level (expected) - (let ((sldb-level (when-let (sldb (sldb-get-buffer)) + (let ((sldb-level (when-let (sldb (sldb-get-default-buffer)) (with-current-buffer sldb sldb-level)))) (slime-check ("SLDB level (%S) is %S" expected sldb-level) @@ -6723,12 +6741,12 @@ (funcall (or test #'equal) expected actual))) (defun sldb-level () - (when-let (sldb (sldb-get-buffer)) + (when-let (sldb (sldb-get-default-buffer)) (with-current-buffer sldb sldb-level))) (defun slime-sldb-level= (level) - (when-let (sldb (sldb-get-buffer)) + (when-let (sldb (sldb-get-default-buffer)) (with-current-buffer sldb (equal sldb-level level)))) @@ -6846,7 +6864,7 @@ (debug-hook-max-depth 0)) (let ((debug-hook (lambda () - (with-current-buffer (sldb-get-buffer) + (with-current-buffer (sldb-get-default-buffer) (when (> sldb-level debug-hook-max-depth) (setq debug-hook-max-depth sldb-level) (if (= sldb-level depth) @@ -6874,7 +6892,7 @@ (slime-check "In eval state." (not (null slime-rex-continuations))) (slime-interrupt) (slime-wait-condition "First interrupt" (lambda () (slime-sldb-level= 1)) 5) - (with-current-buffer (sldb-get-buffer) + (with-current-buffer (sldb-get-default-buffer) (sldb-quit)) (slime-sync-to-top-level 5) (slime-check-top-level)) @@ -6889,13 +6907,14 @@ (slime-wait-condition "running" #'slime-busy-p 5) (slime-interrupt) (slime-wait-condition "First interrupt" (lambda () (slime-sldb-level= 1)) 5) - (with-current-buffer (sldb-get-buffer) + (with-current-buffer (sldb-get-default-buffer) (sldb-continue)) - (slime-wait-condition "running" (lambda () (and (slime-busy-p) - (not (sldb-get-buffer)))) 5) + (slime-wait-condition "running" (lambda () + (and (slime-busy-p) + (not (sldb-get-default-buffer)))) 5) (slime-interrupt) (slime-wait-condition "Second interrupt" (lambda () (slime-sldb-level= 1)) 5) - (with-current-buffer (sldb-get-buffer) + (with-current-buffer (sldb-get-default-buffer) (sldb-quit)) (slime-sync-to-top-level 5) (slime-check-top-level)) @@ -6930,9 +6949,9 @@ (slime-wait-condition "Debugger visible" (lambda () (and (slime-sldb-level= 1) - (get-buffer-window (sldb-get-buffer)))) + (get-buffer-window (sldb-get-default-buffer)))) 5) - (with-current-buffer (sldb-get-buffer) + (with-current-buffer (sldb-get-default-buffer) (sldb-quit)) (slime-sync-to-top-level 5)) @@ -7086,9 +7105,9 @@ (slime-wait-condition "Debugger visible" (lambda () (and (slime-sldb-level= 1) - (get-buffer-window (sldb-get-buffer)))) + (get-buffer-window (sldb-get-default-buffer)))) 5) - (with-current-buffer (sldb-get-buffer) + (with-current-buffer (sldb-get-default-buffer) (sldb-quit)) (slime-sync-to-top-level 5)) From asimon at common-lisp.net Sun Jun 27 11:07:33 2004 From: asimon at common-lisp.net (Andras Simon) Date: Sun, 27 Jun 2004 04:07:33 -0700 Subject: [slime-cvs] CVS update: slime/swank-abcl.lisp Message-ID: Update of /project/slime/cvsroot/slime In directory common-lisp.net:/tmp/cvs-serv16235 Modified Files: swank-abcl.lisp Log Message: Fix thread-name/thread-status. Date: Sun Jun 27 04:07:31 2004 Author: asimon Index: slime/swank-abcl.lisp diff -u slime/swank-abcl.lisp:1.3 slime/swank-abcl.lisp:1.4 --- slime/swank-abcl.lisp:1.3 Wed Jun 16 15:04:56 2004 +++ slime/swank-abcl.lisp Sun Jun 27 04:07:31 2004 @@ -314,10 +314,10 @@ (ext:make-thread (lambda () (funcall fn)))) (defimplementation thread-name (thread) - "thread-name not implemented") + (princ-to-string thread)) (defimplementation thread-status (thread) - (format nil "Thread is ~[dead~;alive~]" (thread-alive-p thread))) + (format nil "Thread is ~:[dead~;alive~]" (ext:thread-alive-p thread))) (defimplementation make-lock (&key name) (ext:make-thread-lock)) From asimon at common-lisp.net Sun Jun 27 12:18:51 2004 From: asimon at common-lisp.net (Andras Simon) Date: Sun, 27 Jun 2004 05:18:51 -0700 Subject: [slime-cvs] CVS update: slime/swank-abcl.lisp Message-ID: Update of /project/slime/cvsroot/slime In directory common-lisp.net:/tmp/cvs-serv8934 Modified Files: swank-abcl.lisp Log Message: Use ABCL's new LW-style mailbox for send/receive. Date: Sun Jun 27 05:18:51 2004 Author: asimon Index: slime/swank-abcl.lisp diff -u slime/swank-abcl.lisp:1.4 slime/swank-abcl.lisp:1.5 --- slime/swank-abcl.lisp:1.4 Sun Jun 27 04:07:31 2004 +++ slime/swank-abcl.lisp Sun Jun 27 05:18:51 2004 @@ -339,43 +339,20 @@ (defvar *mailbox-lock* (ext:make-thread-lock)) -(defstruct (mailbox (:conc-name mailbox.)) - (mutex (ext:make-thread-lock)) - (queue '() :type list)) - (defvar *thread-mailbox* (make-hash-table)) - (defun mailbox (thread) "Return THREAD's mailbox." (ext:with-thread-lock (*mailbox-lock*) (or (gethash thread *thread-mailbox*) (setf (gethash thread *thread-mailbox*) - (make-mailbox))))) + (ext:make-mailbox))))) -(defimplementation send (thread message) - (let* ((mbox (mailbox thread)) - (mutex (mailbox.mutex mbox))) - #+nil - (mp:process-wait-with-timeout - "yielding before sending" 0.1 - (lambda () - (mp:with-process-lock (mutex) - (< (length (mailbox.queue mbox)) 10)))) - ;(sleep 0.1) - (ext:with-thread-lock (mutex) - (setf (mailbox.queue mbox) - (nconc (mailbox.queue mbox) (list message)))))) +(defimplementation send (thread object) + (ext:mailbox-send (mailbox thread) object)) (defimplementation receive () - (let* ((mbox (mailbox (ext:current-thread))) - (mutex (mailbox.mutex mbox))) - #+nil(mp:process-wait "receive" #'mailbox.queue mbox) - (loop until (mailbox.queue mbox) do (sleep 0.1)) ;;FIXME - (ext:with-thread-lock (mutex) - (pop (mailbox.queue mbox))))) - - + (ext:mailbox-read (mailbox (ext:current-thread)))) (defimplementation quit-lisp () (ext:exit)) From heller at common-lisp.net Sun Jun 27 14:58:51 2004 From: heller at common-lisp.net (Helmut Eller) Date: Sun, 27 Jun 2004 07:58:51 -0700 Subject: [slime-cvs] CVS update: slime/swank.lisp Message-ID: Update of /project/slime/cvsroot/slime In directory common-lisp.net:/tmp/cvs-serv6912 Modified Files: swank.lisp Log Message: (dispatch-event): Quitting a from the debugger was seriously broken. Fix it. Move generation of thread ids to the backends. Date: Sun Jun 27 07:58:51 2004 Author: heller Index: slime/swank.lisp diff -u slime/swank.lisp:1.203 slime/swank.lisp:1.204 --- slime/swank.lisp:1.203 Fri Jun 25 01:06:39 2004 +++ slime/swank.lisp Sun Jun 27 07:58:51 2004 @@ -407,102 +407,66 @@ ;;;;;; Thread based communication +(defvar *active-threads* '()) + (defun read-loop (control-thread input-stream connection) (with-reader-error-handler (connection) (loop (send control-thread (decode-message input-stream))))) -(defvar *active-threads* '()) -(defvar *thread-counter* 0) - -(defun remove-dead-threads () - (setq *active-threads* - (remove-if-not #'thread-alive-p *active-threads*))) - -(defun add-thread (thread) - (let ((id (mod (1+ *thread-counter*) most-positive-fixnum))) - (setq *active-threads* (acons id thread *active-threads*) - *thread-counter* id) - id)) - -(defun drop-thread (thread) - "Drop the first occurence of thread in *active-threads* and return its id." - (let ((tail (member thread *active-threads* :key #'cdr :test #'equalp))) - (assert tail) - (setq *active-threads* (append (ldiff *active-threads* tail) (rest tail))) - (car (first tail)))) - -(defvar *lookup-counter* nil - "A simple counter used to remove dead threads from *active-threads*.") - -(defun lookup-thread (thread) - (when (zerop (decf *lookup-counter*)) - (setf *lookup-counter* 50) - (remove-dead-threads)) - (let ((probe (rassoc thread *active-threads*))) - (cond (probe (car probe)) - (t (add-thread thread))))) - -(defun lookup-thread-id (id &optional noerror) - (let ((probe (assoc id *active-threads*))) - (cond (probe (cdr probe)) - (noerror nil) - (t (error "Thread id not found ~S" id))))) - (defun dispatch-loop (socket-io connection) - (let ((*emacs-connection* connection) - (*active-threads* '()) - (*thread-counter* 0) - (*lookup-counter* 50)) + (let ((*emacs-connection* connection)) (loop (with-simple-restart (abort "Restart dispatch loop.") (loop (dispatch-event (receive) socket-io)))))) -(defun interrupt-worker-thread (thread) - (let ((thread (etypecase thread - ((member t) - (cdr (car *active-threads*))) +(defun interrupt-worker-thread (id) + (let ((thread (etypecase id + ((member t) + (car *active-threads*)) ((member :repl-thread) (connection.repl-thread *emacs-connection*)) (fixnum - (lookup-thread-id thread))))) + (find-thread id))))) (interrupt-thread thread #'simple-break))) -(defun thread-for-evaluation (thread) +(defun thread-for-evaluation (id) "Find or create a thread to evaluate the next request." (let ((c *emacs-connection*)) - (etypecase thread + (etypecase id ((member t) (spawn (lambda () (handle-request c)) :name "worker")) ((member :repl-thread) (connection.repl-thread c)) (fixnum - (lookup-thread-id thread))))) + (find-thread id))))) (defun dispatch-event (event socket-io) (log-event "DISPATCHING: ~S~%" event) (destructure-case event - ((:emacs-rex form package thread id) - (let ((thread (thread-for-evaluation thread))) - (send thread `(eval-for-emacs ,form ,package ,id)) - (add-thread thread))) - ((:emacs-interrupt thread) - (interrupt-worker-thread thread)) - (((:debug :debug-condition :debug-activate) thread &rest args) - (encode-message `(,(car event) ,(add-thread thread) . ,args) socket-io)) - ((:debug-return thread level) - (encode-message `(:debug-return ,(drop-thread thread) ,level) socket-io)) + ((:emacs-rex form package thread-id id) + (let ((thread (thread-for-evaluation thread-id))) + (push thread *active-threads*) + (send thread `(eval-for-emacs ,form ,package ,id)))) ((:return thread &rest args) - (drop-thread thread) + (let ((tail (member thread *active-threads*))) + (setq *active-threads* (nconc (ldiff *active-threads* tail) + (cdr tail)))) (encode-message `(:return , at args) socket-io)) + ((:emacs-interrupt thread-id) + (interrupt-worker-thread thread-id)) + (((:debug :debug-condition :debug-activate :debug-return) + thread &rest args) + (encode-message `(,(car event) ,(thread-id thread) , at args) socket-io)) ((:read-string thread &rest args) - (encode-message `(:read-string ,(add-thread thread) , at args) socket-io)) + (encode-message `(:read-string ,(thread-id thread) , at args) socket-io)) ((:read-aborted thread &rest args) - (encode-message `(:read-aborted ,(drop-thread thread) , at args) socket-io)) - ((:emacs-return-string thread tag string) - (send (lookup-thread-id thread) `(take-input ,tag ,string))) + (encode-message `(:read-aborted ,(thread-id thread) , at args) socket-io)) + ((:emacs-return-string thread-id tag string) + (send (find-thread thread-id) `(take-input ,tag ,string))) (((:read-output :new-package :new-features :ed :%apply :indentation-update) &rest _) (declare (ignore _)) - (encode-message event socket-io)))) + (encode-message event socket-io)) + )) (defun spawn-threads-for-connection (connection) (let* ((socket-io (connection.socket-io connection)) @@ -596,7 +560,8 @@ (defun send-to-socket-io (event) (log-event "DISPATCHING: ~S~%" event) - (flet ((send (o) (encode-message o (current-socket-io)))) + (flet ((send (o) (without-interrupts + (encode-message o (current-socket-io))))) (destructure-case event (((:debug-activate :debug :debug-return :read-string :read-aborted) thread &rest args) @@ -861,13 +826,12 @@ (let* ((string (prin1-to-string-for-emacs message)) (length (1+ (length string)))) (log-event "WRITE: ~A~%" string) - (without-interrupts - (loop for position from 16 downto 0 by 8 - do (write-char (code-char (ldb (byte 8 position) length)) - stream)) - (write-string string stream) - (terpri stream) - (force-output stream)))) + (loop for position from 16 downto 0 by 8 + do (write-char (code-char (ldb (byte 8 position) length)) + stream)) + (write-string string stream) + (terpri stream) + (force-output stream))) (defun prin1-to-string-for-emacs (object) (with-standard-io-syntax @@ -2585,25 +2549,25 @@ (defslimefun quit-thread-browser () (setq *thread-list* nil)) -(defun lookup-thread-by-id (id) - (nth id *thread-list*)) +(defun nth-thread (index) + (nth index *thread-list*)) -(defslimefun debug-thread-by-id (thread-id) +(defslimefun debug-nth-thread (index) (let ((connection *emacs-connection*)) - (interrupt-thread (lookup-thread-by-id thread-id) + (interrupt-thread (nth-thread index) (lambda () (with-connection (connection) (simple-break)))))) -(defslimefun start-swank-server-in-thread (id port-file-name) - "Interrupt a thread by ID and make it start a swank server. +(defslimefun kill-nth-thread (index) + (kill-thread (nth-thread index))) + +(defslimefun start-swank-server-in-thread (index port-file-name) + "Interrupt the INDEXth thread and make it start a swank server. The server port is written to PORT-FILE-NAME." - (interrupt-thread (lookup-thread-by-id id) - (lambda () + (interrupt-thread (nth-thread index) + (lambda () (start-server port-file-name nil)))) - -(defslimefun kill-thread-by-id (id) - (kill-thread (lookup-thread-by-id id))) ;;;; Automatically synchronized state From heller at common-lisp.net Sun Jun 27 15:00:17 2004 From: heller at common-lisp.net (Helmut Eller) Date: Sun, 27 Jun 2004 08:00:17 -0700 Subject: [slime-cvs] CVS update: slime/swank-abcl.lisp Message-ID: Update of /project/slime/cvsroot/slime In directory common-lisp.net:/tmp/cvs-serv13770 Modified Files: swank-abcl.lisp Log Message: (thread-id, find-thread): New backend function. Date: Sun Jun 27 08:00:17 2004 Author: heller Index: slime/swank-abcl.lisp diff -u slime/swank-abcl.lisp:1.5 slime/swank-abcl.lisp:1.6 --- slime/swank-abcl.lisp:1.5 Sun Jun 27 05:18:51 2004 +++ slime/swank-abcl.lisp Sun Jun 27 08:00:17 2004 @@ -309,10 +309,27 @@ (defimplementation startup-multiprocessing () #+nil(mp:start-scheduler)) - (defimplementation spawn (fn &key name) (ext:make-thread (lambda () (funcall fn)))) +(defvar *thread-props-lock* (ext:make-thread-lock)) + +(defvar *thread-props* (make-hash-table) ; should be a weak table + "A hashtable mapping threads to a plist.") + +(defvar *thread-id-counter* 0) + +(defimplementation thread-id (thread) + (ext:with-thread-lock (*thread-props-lock*) + (or (getf (gethash thread *thread-props*) 'id) + (setf (getf (gethash thread *thread-props*) 'id) + (incf *thread-id-counter*))))) + +(defimplementation find-thread (id) + (find id (all-threads) + :test (lambda (thread) + (getf (gethash thread *thread-props*) 'id)))) + (defimplementation thread-name (thread) (princ-to-string thread)) @@ -337,15 +354,11 @@ (defimplementation kill-thread (thread) (ext:destroy-thread thread)) -(defvar *mailbox-lock* (ext:make-thread-lock)) - -(defvar *thread-mailbox* (make-hash-table)) - (defun mailbox (thread) "Return THREAD's mailbox." - (ext:with-thread-lock (*mailbox-lock*) - (or (gethash thread *thread-mailbox*) - (setf (gethash thread *thread-mailbox*) + (ext:with-thread-lock (*thread-props-lock*) + (or (getf (gethash thread *thread-props*) 'mailbox) + (setf (getf (gethash thread *thread-props*) 'mailbox) (ext:make-mailbox))))) (defimplementation send (thread object) From heller at common-lisp.net Sun Jun 27 15:00:23 2004 From: heller at common-lisp.net (Helmut Eller) Date: Sun, 27 Jun 2004 08:00:23 -0700 Subject: [slime-cvs] CVS update: slime/swank-allegro.lisp Message-ID: Update of /project/slime/cvsroot/slime In directory common-lisp.net:/tmp/cvs-serv14528 Modified Files: swank-allegro.lisp Log Message: (thread-id, find-thread): New backend function. Date: Sun Jun 27 08:00:23 2004 Author: heller Index: slime/swank-allegro.lisp diff -u slime/swank-allegro.lisp:1.39 slime/swank-allegro.lisp:1.40 --- slime/swank-allegro.lisp:1.39 Fri Jun 25 01:05:21 2004 +++ slime/swank-allegro.lisp Sun Jun 27 08:00:23 2004 @@ -297,6 +297,19 @@ (defimplementation spawn (fn &key name) (mp:process-run-function name fn)) +(defvar *id-lock* (mp:make-process-lock :name "id lock")) +(defvar *thread-id-counter* 0) + +(defimplementation thread-id (thread) + (mp:with-process-lock (*id-lock*) + (or (getf (mp:process-property-list thread) 'id) + (setf (getf (mp:process-property-list thread) 'id) + (incf *thread-id-counter*))))) + +(defimplementation find-thread (id) + (find id mp:*all-processes* + :key (lambda (p) (getf (mp:process-property-list p) 'id)))) + (defimplementation thread-name (thread) (mp:process-name thread)) From heller at common-lisp.net Sun Jun 27 15:00:30 2004 From: heller at common-lisp.net (Helmut Eller) Date: Sun, 27 Jun 2004 08:00:30 -0700 Subject: [slime-cvs] CVS update: slime/swank-backend.lisp Message-ID: Update of /project/slime/cvsroot/slime In directory common-lisp.net:/tmp/cvs-serv14997 Modified Files: swank-backend.lisp Log Message: (thread-id, find-thread): New backend function. Date: Sun Jun 27 08:00:30 2004 Author: heller Index: slime/swank-backend.lisp diff -u slime/swank-backend.lisp:1.57 slime/swank-backend.lisp:1.58 --- slime/swank-backend.lisp:1.57 Fri Jun 25 01:05:25 2004 +++ slime/swank-backend.lisp Sun Jun 27 08:00:30 2004 @@ -180,6 +180,9 @@ "Return a suitable initial value for SWANK:*READTABLE-ALIST*." '()) +(definterface quit-lisp () + "Exit the current lisp image.") + ;;;; Compilation @@ -550,6 +553,17 @@ (definterface spawn (fn &key name) "Create a new thread to call FN.") +(definterface thread-id (thread) + "Return an Emacs-parsable object to identify THREAD. + +Ids should be comparable with equal, i.e.: + (equal (thread-id ) (thread-id )) <==> (eq )") + +(definterface find-thread (id) + "Return the thread for ID. +ID should be an id previously obtained with THREAD-ID. +Can return nil if the thread no longer exists.") + (definterface thread-name (thread) "Return the name of THREAD. @@ -599,6 +613,3 @@ (definterface receive () "Return the next message from current thread's mailbox.") - -(definterface quit-lisp () - "Exit the current lisp image.") From heller at common-lisp.net Sun Jun 27 15:00:37 2004 From: heller at common-lisp.net (Helmut Eller) Date: Sun, 27 Jun 2004 08:00:37 -0700 Subject: [slime-cvs] CVS update: slime/swank-cmucl.lisp Message-ID: Update of /project/slime/cvsroot/slime In directory common-lisp.net:/tmp/cvs-serv15110 Modified Files: swank-cmucl.lisp Log Message: (thread-id, find-thread): New backend function. Date: Sun Jun 27 08:00:37 2004 Author: heller Index: slime/swank-cmucl.lisp diff -u slime/swank-cmucl.lisp:1.108 slime/swank-cmucl.lisp:1.109 --- slime/swank-cmucl.lisp:1.108 Fri Jun 25 01:05:34 2004 +++ slime/swank-cmucl.lisp Sun Jun 27 08:00:37 2004 @@ -1735,6 +1735,17 @@ (defimplementation spawn (fn &key (name "Anonymous")) (mp:make-process fn :name name)) + (defvar *thread-id-counter* 0) + + (defimplementation thread-id (thread) + (or (getf (mp:process-property-list thread) 'id) + (setf (getf (mp:process-property-list thread) 'id) + (incf *thread-id-counter*)))) + + (defimplementation find-thread (id) + (find id (all-threads) + :key (lambda (p) (getf (mp:process-property-list p) 'id)))) + (defimplementation thread-name (thread) (mp:process-name thread)) From heller at common-lisp.net Sun Jun 27 15:00:43 2004 From: heller at common-lisp.net (Helmut Eller) Date: Sun, 27 Jun 2004 08:00:43 -0700 Subject: [slime-cvs] CVS update: slime/swank-lispworks.lisp Message-ID: Update of /project/slime/cvsroot/slime In directory common-lisp.net:/tmp/cvs-serv15159 Modified Files: swank-lispworks.lisp Log Message: (thread-id, find-thread): New backend function. Date: Sun Jun 27 08:00:43 2004 Author: heller Index: slime/swank-lispworks.lisp diff -u slime/swank-lispworks.lisp:1.47 slime/swank-lispworks.lisp:1.48 --- slime/swank-lispworks.lisp:1.47 Fri Jun 25 01:05:38 2004 +++ slime/swank-lispworks.lisp Sun Jun 27 08:00:43 2004 @@ -91,7 +91,7 @@ (defimplementation call-without-interrupts (fn) (lw:without-interrupts (funcall fn))) - + (defimplementation getpid () #+win32 (win32:get-current-process-id) #-win32 (system::getpid)) @@ -196,8 +196,9 @@ "Unwind FRAME N times." (do ((frame frame (dbg::frame-next frame)) (i n (if (interesting-frame-p frame) (1- i) i))) - ((and (interesting-frame-p frame) (zerop i)) frame) - (assert frame))) + ((or (not frame) + (and (interesting-frame-p frame) (zerop i))) + frame))) (defun nth-frame (index) (nth-next-frame *sldb-top-frame* index)) @@ -536,6 +537,19 @@ mp:*process-initial-bindings* :key (lambda (x) (symbol-package (car x)))))) (mp:process-run-function name () fn))) + +(defvar *id-lock* (mp:make-lock)) +(defvar *thread-id-counter* 0) + +(defimplementation thread-id (thread) + (mp:with-lock (*id-lock*) + (or (getf (mp:process-plist thread) 'id) + (setf (getf (mp:process-plist thread) 'id) + (incf *thread-id-counter*))))) + +(defimplementation find-thread (id) + (find id (mp:list-all-processes) + :key (lambda (p) (getf (mp:process-plist p) 'id)))) (defimplementation thread-name (thread) (mp:process-name thread)) From heller at common-lisp.net Sun Jun 27 15:00:50 2004 From: heller at common-lisp.net (Helmut Eller) Date: Sun, 27 Jun 2004 08:00:50 -0700 Subject: [slime-cvs] CVS update: slime/swank-openmcl.lisp Message-ID: Update of /project/slime/cvsroot/slime In directory common-lisp.net:/tmp/cvs-serv15410 Modified Files: swank-openmcl.lisp Log Message: (thread-id, find-thread): New backend function. Date: Sun Jun 27 08:00:50 2004 Author: heller Index: slime/swank-openmcl.lisp diff -u slime/swank-openmcl.lisp:1.77 slime/swank-openmcl.lisp:1.78 --- slime/swank-openmcl.lisp:1.77 Wed Jun 16 15:04:04 2004 +++ slime/swank-openmcl.lisp Sun Jun 27 08:00:50 2004 @@ -520,6 +520,12 @@ (defimplementation startup-multiprocessing ()) +(defimplementation thread-id (thread) + (ccl::process-serial-number thread)) + +(defimplementation find-thread (id) + (find id (ccl:all-processes) :key #'ccl::process-serial-number)) + (defimplementation thread-name (thread) (ccl::process-name thread)) From heller at common-lisp.net Sun Jun 27 15:00:57 2004 From: heller at common-lisp.net (Helmut Eller) Date: Sun, 27 Jun 2004 08:00:57 -0700 Subject: [slime-cvs] CVS update: slime/swank-sbcl.lisp Message-ID: Update of /project/slime/cvsroot/slime In directory common-lisp.net:/tmp/cvs-serv15619 Modified Files: swank-sbcl.lisp Log Message: (thread-id, find-thread): New backend function. Date: Sun Jun 27 08:00:56 2004 Author: heller Index: slime/swank-sbcl.lisp diff -u slime/swank-sbcl.lisp:1.92 slime/swank-sbcl.lisp:1.93 --- slime/swank-sbcl.lisp:1.92 Fri Jun 25 01:06:20 2004 +++ slime/swank-sbcl.lisp Sun Jun 27 08:00:56 2004 @@ -742,6 +742,13 @@ (defimplementation startup-multiprocessing ()) + (defimplementation thread-id (thread) + thread) + + (defimplementation find-thread (id) + (if (member id (all-threads)) + id)) + (defimplementation thread-name (thread) (format nil "Thread ~D" thread)) From heller at common-lisp.net Sun Jun 27 15:03:18 2004 From: heller at common-lisp.net (Helmut Eller) Date: Sun, 27 Jun 2004 08:03:18 -0700 Subject: [slime-cvs] CVS update: slime/swank-source-path-parser.lisp Message-ID: Update of /project/slime/cvsroot/slime In directory common-lisp.net:/tmp/cvs-serv22038 Modified Files: swank-source-path-parser.lisp Log Message: (cmucl-style-get-macro-character): Add tests for #\space and #\\. (Suggested by Christophe Rhodes.) Date: Sun Jun 27 08:03:18 2004 Author: heller Index: slime/swank-source-path-parser.lisp diff -u slime/swank-source-path-parser.lisp:1.5 slime/swank-source-path-parser.lisp:1.6 --- slime/swank-source-path-parser.lisp:1.5 Mon Mar 29 09:49:38 2004 +++ slime/swank-source-path-parser.lisp Sun Jun 27 08:03:18 2004 @@ -44,22 +44,61 @@ ;; to set it from another character) we have to compare against ;; this undefined-macro function to avoid turning everything into ;; a macro -- Dan Barlow -;; -;; Just copy CMUCL's implementation, to get identical behavior. The -;; SBCL implementation uses GET-RAW-CMT-ENTRY; we use -;; GET-COERCED-CMT-ENTRY, which seems to be what SET-MACRO-CHARACTER -;; expects. -- Helmut Eller -(defun cmucl-style-get-macro-character (char table) - (let ((rt (or table sb-impl::*standard-readtable*))) - (cond ((sb-impl::constituentp char) - (values (sb-impl::get-coerced-cmt-entry char rt) t)) - ((sb-impl::terminating-macrop char) - (values (sb-impl::get-coerced-cmt-entry char rt) nil)) - (t nil)))) +(if (not (get-macro-character #\space nil)) + (defun cmucl-style-get-macro-character (char table) + (get-macro-character char table)) + (defun cmucl-style-get-macro-character (char table) + (let ((rt (or table sb-impl::*standard-readtable*))) + (cond ((sb-impl::constituentp char) + (values (sb-impl::get-coerced-cmt-entry char rt) t)) + ((sb-impl::terminating-macrop char) + (values (sb-impl::get-coerced-cmt-entry char rt) nil)) + (t + (values nil nil)))))) #+cmu (defun cmucl-style-get-macro-character (char table) (get-macro-character char table)) + +;; Unlike CMUCL, SBCL stores NIL values into the character-macro-table +;; for constituent (in the CL sense) chars, and uses +;; get-coerced-cmt-entry to convert those NILs to #'read-token. In +;; CMUCL all constituents are also macro-chars. +;; +;; CMUCL and SBCL use a somewhat strange encoding for CL's Character +;; Syntax Types: +;; +;; CL Implementation +;; ---------------- -------------- +;; Constituent (constituentp x) i.e. (<= +char-attr-constituent+ x) +;; Macro Char (constituentp x) or +char-attr-terminating-macro+ +;; Single Escape +char-attr-escape+ +;; Invalid (constituentp x) with undefined-macro-char as fun +;; Multiple Escape +char-attr-multiple-escape+ +;; Whitespace +char-attr-whitespace+ +;; +;; One effect of this encoding is that invalid chars are not detected +;; inside tokens and it seems that there's no good way to distinguish +;; constituents from macro-chars. + +(defun dump-readtable (rt) + (dotimes (code char-code-limit) + (let ((char (code-char code))) + (multiple-value-bind (fn terminatingp) (get-macro-character char rt) + (format t "~S[~D]: ~12,1T~A ~A~%" + char code fn terminatingp))))) + +;; (dump-readtable *readtable*) + +(let ((rt (copy-readtable nil))) + ;; If #\space is a macro-char, it shouldn't terminate tokens. + (assert (or (not (cmucl-style-get-macro-character #\space rt)) + (nth-value 1 (cmucl-style-get-macro-character #\space rt)))) + ;; In SBCL (get-macro-character #\\) returns #'read-token, t. And + ;; (set-macro-character #\\ #'read-token t) confuses #'read-string, + ;; because it uses the attributes in the readtable for parsing + ;; decisions. + (assert (not (cmucl-style-get-macro-character #\\ rt)))) (defun make-source-recording-readtable (readtable source-map) "Return a source position recording copy of READTABLE. From heller at common-lisp.net Sun Jun 27 15:04:07 2004 From: heller at common-lisp.net (Helmut Eller) Date: Sun, 27 Jun 2004 08:04:07 -0700 Subject: [slime-cvs] CVS update: slime/slime.el Message-ID: Update of /project/slime/cvsroot/slime In directory common-lisp.net:/tmp/cvs-serv24698 Modified Files: slime.el Log Message: *** empty log message *** Date: Sun Jun 27 08:04:07 2004 Author: heller Index: slime/slime.el diff -u slime/slime.el:1.338 slime/slime.el:1.339 --- slime/slime.el:1.338 Sat Jun 26 23:57:25 2004 +++ slime/slime.el Sun Jun 27 08:04:07 2004 @@ -5983,7 +5983,7 @@ (defun slime-thread-kill () (interactive) (let ((id (get-text-property (point) 'thread-id))) - (slime-eval `(swank:kill-thread-by-id ,id))) + (slime-eval `(swank:kill-nth-thread ,id))) (call-interactively 'slime-list-threads)) (defun slime-thread-attach () @@ -5998,7 +5998,7 @@ (defun slime-thread-debug () (interactive) (let ((id (get-text-property (point) 'thread-id))) - (slime-eval-async `(swank::debug-thread-by-id ,id) + (slime-eval-async `(swank:debug-nth-thread ,id) (slime-buffer-package) (lambda (v) nil)))) From heller at common-lisp.net Sun Jun 27 15:05:13 2004 From: heller at common-lisp.net (Helmut Eller) Date: Sun, 27 Jun 2004 08:05:13 -0700 Subject: [slime-cvs] CVS update: slime/doc/slime.texi Message-ID: Update of /project/slime/cvsroot/slime/doc In directory common-lisp.net:/tmp/cvs-serv26476 Modified Files: slime.texi Log Message: Remove macros from chapter and section headings to avoid texi2pdf breakage. Date: Sun Jun 27 08:05:13 2004 Author: heller Index: slime/doc/slime.texi diff -u slime/doc/slime.texi:1.16 slime/doc/slime.texi:1.17 --- slime/doc/slime.texi:1.16 Wed Jun 23 15:51:00 2004 +++ slime/doc/slime.texi Sun Jun 27 08:05:13 2004 @@ -46,7 +46,7 @@ @end macro @set EDITION DRAFT - at set UPDATED @code{$Id: slime.texi,v 1.16 2004/06/23 22:51:00 bdowning Exp $} + at set UPDATED @code{$Id: slime.texi,v 1.17 2004/06/27 15:05:13 heller Exp $} @titlepage @title SLIME User Manual @@ -249,7 +249,7 @@ commands (like ``restart frame''). @node Downloading, Installation, Platforms, Getting started - at section Downloading @SLIME{} (from @CVS{}) + at section Downloading SLIME (from CVS) @SLIME{} is available from the @CVS{} repository on @file{common-lisp.net}. You have the option to use either the very @@ -274,7 +274,7 @@ @end menu @node CVS Incantations, , Downloading, Downloading - at subsection @CVS{} incantations + at subsection CVS incantations To download @SLIME{} you first configure your @code{CVSROOT} and login to the repository. @@ -325,7 +325,7 @@ @end iftex @node Running, , Installation, Getting started - at section Running @SLIME{} + at section Running SLIME @SLIME{} is started with the Emacs command @kbd{M-x slime}. This uses the @code{inferior-lisp} package to start a Lisp process, loads and @@ -744,7 +744,7 @@ be scanned for indentation information. @node REPL, Debugger, slime-mode, Top - at chapter @REPL{}: the ``top level'' + at chapter REPL: the ``top level'' @SLIME{} uses a custom Read-Eval-Print Loop (@REPL{}, also known as a ``top level''). The @REPL{} user-interface is written in Emacs Lisp, @@ -770,7 +770,7 @@ @end menu @node REPL commands, Input Navigation, REPL, REPL - at section @REPL{} commands + at section REPL commands @table @kbd @@ -845,7 +845,7 @@ shortcut to list them interactively. @node Debugger, Extras, REPL, Top - at chapter @SLDB{}: the @SLIME{} debugger + at chapter SLDB: the SLIME debugger @SLIME{} has a custom Emacs-based debugger called @SLDB{}. Conditions signalled in the Lisp system invoke @SLDB{} in Emacs by way of the From heller at common-lisp.net Sun Jun 27 15:08:06 2004 From: heller at common-lisp.net (Helmut Eller) Date: Sun, 27 Jun 2004 08:08:06 -0700 Subject: [slime-cvs] CVS update: slime/ChangeLog Message-ID: Update of /project/slime/cvsroot/slime In directory common-lisp.net:/tmp/cvs-serv1820 Modified Files: ChangeLog Log Message: *** empty log message *** Date: Sun Jun 27 08:08:06 2004 Author: heller Index: slime/ChangeLog diff -u slime/ChangeLog:1.429 slime/ChangeLog:1.430 --- slime/ChangeLog:1.429 Fri Jun 25 03:13:40 2004 +++ slime/ChangeLog Sun Jun 27 08:08:06 2004 @@ -1,3 +1,22 @@ +2004-06-27 Helmut Eller + + * doc/slime.texi: Remove macros from chapter and section headings + to avoid texi2pdf breakage. + + * swank-source-path-parser.lisp (cmucl-style-get-macro-character): + Add tests for #\space and #\\. Suggested by Christophe Rhodes. + + * swank-sbcl.lisp, swank-openmcl.lisp, swank-lispworks.lisp, + swank-cmucl.lisp, swank-backend.lisp, swank-allegro.lisp, + swank-abcl.lisp (thread-id, find-thread): New backend functions. + + * swank.lisp (dispatch-event): Quitting from the debugger was + seriously broken. Fix it. Move generation of thread ids to the + backends. + + * slime.el (sldb-get-buffer): Add support for sldb buffers for + multiple threads. + 2004-06-25 Thomas F. Burdick * swank-sbcl.lisp (call-with-syntax-hooks, with-debootstrapping): From heller at common-lisp.net Sun Jun 27 15:23:54 2004 From: heller at common-lisp.net (Helmut Eller) Date: Sun, 27 Jun 2004 08:23:54 -0700 Subject: [slime-cvs] CVS update: slime/ChangeLog Message-ID: Update of /project/slime/cvsroot/slime In directory common-lisp.net:/tmp/cvs-serv11089 Modified Files: ChangeLog Log Message: *** empty log message *** Date: Sun Jun 27 08:23:54 2004 Author: heller Index: slime/ChangeLog diff -u slime/ChangeLog:1.430 slime/ChangeLog:1.431 --- slime/ChangeLog:1.430 Sun Jun 27 08:08:06 2004 +++ slime/ChangeLog Sun Jun 27 08:23:54 2004 @@ -13,6 +13,12 @@ * swank.lisp (dispatch-event): Quitting from the debugger was seriously broken. Fix it. Move generation of thread ids to the backends. + (encode-message, send-to-socket-io): Use WITHOUT-INTERRUPTS in + send-to-socket-io. The multithreaded version of encode-message + doesn't need it. + (nth-thread): Renamed from lookup-thread-by-id. + (debug-nth-thread): Renamed from debug-thread-by-id: + (kill-nth-thread): Renamed from kill-thread-by-id. * slime.el (sldb-get-buffer): Add support for sldb buffers for multiple threads. From asimon at common-lisp.net Sun Jun 27 17:10:33 2004 From: asimon at common-lisp.net (Andras Simon) Date: Sun, 27 Jun 2004 10:10:33 -0700 Subject: [slime-cvs] CVS update: slime/swank-abcl.lisp Message-ID: Update of /project/slime/cvsroot/slime In directory common-lisp.net:/tmp/cvs-serv12519 Modified Files: swank-abcl.lisp Log Message: find-thread: :test => :key Date: Sun Jun 27 10:10:33 2004 Author: asimon Index: slime/swank-abcl.lisp diff -u slime/swank-abcl.lisp:1.6 slime/swank-abcl.lisp:1.7 --- slime/swank-abcl.lisp:1.6 Sun Jun 27 08:00:17 2004 +++ slime/swank-abcl.lisp Sun Jun 27 10:10:33 2004 @@ -327,7 +327,7 @@ (defimplementation find-thread (id) (find id (all-threads) - :test (lambda (thread) + :key (lambda (thread) (getf (gethash thread *thread-props*) 'id)))) (defimplementation thread-name (thread) From brethren199eventide at ctm.net Mon Jun 28 01:20:14 2004 From: brethren199eventide at ctm.net (Rodolfo Vela) Date: Sun, 27 Jun 2004 20:20:14 -0500 Subject: [slime-cvs] The M.ortgage Information you wanted Message-ID: An HTML attachment was scrubbed... URL: From orbmugfgsyu at ureach.com Mon Jun 28 03:11:16 2004 From: orbmugfgsyu at ureach.com (Gloria ) Date: Mon, 28 Jun 2004 09:11:16 +0600 Subject: [slime-cvs] pay less for Premiere 7 boltzmann Message-ID: <9466073525267033.62865@orbmugfgsyu@ureach.com> An HTML attachment was scrubbed... URL: From CotyPeacock at ausi.com Mon Jun 28 07:11:42 2004 From: CotyPeacock at ausi.com (Pooja Diez) Date: Mon, 28 Jun 2004 12:11:42 +0500 Subject: [slime-cvs] check this out Message-ID: An HTML attachment was scrubbed... URL: From lgorrie at common-lisp.net Mon Jun 28 10:19:11 2004 From: lgorrie at common-lisp.net (Luke Gorrie) Date: Mon, 28 Jun 2004 03:19:11 -0700 Subject: [slime-cvs] CVS update: slime/hyperspec.el Message-ID: Update of /project/slime/cvsroot/slime In directory common-lisp.net:/tmp/cvs-serv2505 Modified Files: hyperspec.el Log Message: >From Christohpe Rhodes: Add support for issue cross-reference lookups, strongly inspired by hyperspec symbol lookup. (common-lisp-hyperspec-issuex-table, common-lisp-hyperspec-issuex-symbols): new variables (common-lisp-issuex): new function Add support for glossary lookups. (common-lisp-glossary-fun): new variable (common-lisp-glossary-4.0, common-lisp-glossary-6.0): new functions Date: Mon Jun 28 03:19:11 2004 Author: lgorrie Index: slime/hyperspec.el diff -u slime/hyperspec.el:1.3 slime/hyperspec.el:1.4 --- slime/hyperspec.el:1.3 Thu Jun 24 06:00:45 2004 +++ slime/hyperspec.el Mon Jun 28 03:19:11 2004 @@ -1223,6 +1223,427 @@ ("Missing and Additional FORMAT Arguments" (22 3 10 2)) ("Additional FORMAT Parameters" (22 3 10 3)))) +(defvar common-lisp-glossary-fun 'common-lisp-glossary-6.0) + +(defun common-lisp-glossary-6.0 (string) + (format "%sBody/26_glo_%s.htm#%s" + common-lisp-hyperspec-root + (let ((char (string-to-char string))) + (if (and (<= ?a char) + (<= char ?z)) + (make-string 1 char) + "9")) + (subst-char-in-string ?\ ?_ string))) + +(defun common-lisp-glossary-4.0 (string) + (format "%sBody/glo_%s.html#%s" + common-lisp-hyperspec-root + (let ((char (string-to-char string))) + (if (and (<= ?a char) + (<= char ?z)) + (make-string 1 char) + "9")) + (subst-char-in-string ?\ ?_ string))) + +(defvar common-lisp-hyperspec-issuex-table nil + "The HyperSpec IssueX table file. If you copy the HyperSpec to your +local system, set this variable to the location of the Issue +cross-references table which is usually \"Map_IssX.txt\" or +\"Issue-Cross-Refs.text\".") + +(defvar common-lisp-hyperspec-issuex-symbols (make-vector 67 0)) + +(if common-lisp-hyperspec-issuex-table + (let ((index-buffer (find-file-noselect common-lisp-hyperspec-issuex-table))) + (labels ((get-one-line () + (prog1 + (delete* ?\n (thing-at-point 'line)) + (forward-line)))) + (save-excursion + (set-buffer index-buffer) + (goto-char (point-min)) + (while (< (point) (point-max)) + (let* ((symbol (intern (downcase (get-one-line)) + common-lisp-hyperspec-issuex-symbols)) + (relative-url (get-one-line))) + (set symbol (subseq relative-url + (1+ (position ?\/ relative-url :from-end t))))))))) + (mapcar + (lambda (entry) + (let ((symbol (intern (car entry) common-lisp-hyperspec-issuex-symbols))) + (set symbol (cadr entry)))) + '(("&environment-binding-order:first" "iss001.htm") + ("access-error-name" "iss002.htm") + ("adjust-array-displacement" "iss003.htm") + ("adjust-array-fill-pointer" "iss004.htm") + ("adjust-array-not-adjustable:implicit-copy" "iss005.htm") + ("allocate-instance:add" "iss006.htm") + ("allow-local-inline:inline-notinline" "iss007.htm") + ("allow-other-keys-nil:permit" "iss008.htm") + ("aref-1d" "iss009.htm") + ("argument-mismatch-error-again:consistent" "iss010.htm") + ("argument-mismatch-error-moon:fix" "iss011.htm") + ("argument-mismatch-error:more-clarifications" "iss012.htm") + ("arguments-underspecified:specify" "iss013.htm") + ("array-dimension-limit-implications:all-fixnum" "iss014.htm") + ("array-type-element-type-semantics:unify-upgrading" "iss015.htm") + ("assert-error-type:error" "iss016.htm") + ("assoc-rassoc-if-key" "iss017.htm") + ("assoc-rassoc-if-key:yes" "iss018.htm") + ("boa-aux-initialization:error-on-read" "iss019.htm") + ("break-on-warnings-obsolete:remove" "iss020.htm") + ("broadcast-stream-return-values:clarify-minimally" "iss021.htm") + ("butlast-negative:should-signal" "iss022.htm") + ("change-class-initargs:permit" "iss023.htm") + ("char-name-case:x3j13-mar-91" "iss024.htm") + ("character-loose-ends:fix" "iss025.htm") + ("character-proposal:2" "iss026.htm") + ("character-proposal:2-1-1" "iss027.htm") + ("character-proposal:2-1-2" "iss028.htm") + ("character-proposal:2-2-1" "iss029.htm") + ("character-proposal:2-3-1" "iss030.htm") + ("character-proposal:2-3-2" "iss031.htm") + ("character-proposal:2-3-3" "iss032.htm") + ("character-proposal:2-3-4" "iss033.htm") + ("character-proposal:2-3-5" "iss034.htm") + ("character-proposal:2-3-6" "iss035.htm") + ("character-proposal:2-4-1" "iss036.htm") + ("character-proposal:2-4-2" "iss037.htm") + ("character-proposal:2-4-3" "iss038.htm") + ("character-proposal:2-5-2" "iss039.htm") + ("character-proposal:2-5-6" "iss040.htm") + ("character-proposal:2-5-7" "iss041.htm") + ("character-proposal:2-6-1" "iss042.htm") + ("character-proposal:2-6-2" "iss043.htm") + ("character-proposal:2-6-3" "iss044.htm") + ("character-proposal:2-6-5" "iss045.htm") + ("character-vs-char:less-inconsistent-short" "iss046.htm") + ("class-object-specializer:affirm" "iss047.htm") + ("clos-conditions-again:allow-subset" "iss048.htm") + ("clos-conditions:integrate" "iss049.htm") + ("clos-error-checking-order:no-applicable-method-first" "iss050.htm") + ("clos-macro-compilation:minimal" "iss051.htm") + ("close-constructed-stream:argument-stream-only" "iss052.htm") + ("closed-stream-operations:allow-inquiry" "iss053.htm") + ("coercing-setf-name-to-function:all-function-names" "iss054.htm") + ("colon-number" "iss055.htm") + ("common-features:specify" "iss056.htm") + ("common-type:remove" "iss057.htm") + ("compile-argument-problems-again:fix" "iss058.htm") + ("compile-file-handling-of-top-level-forms:clarify" "iss059.htm") + ("compile-file-output-file-defaults:input-file" "iss060.htm") + ("compile-file-package" "iss061.htm") + ("compile-file-pathname-arguments:make-consistent" "iss062.htm") + ("compile-file-symbol-handling:new-require-consistency" "iss063.htm") + ("compiled-function-requirements:tighten" "iss064.htm") + ("compiler-diagnostics:use-handler" "iss065.htm") + ("compiler-let-confusion:eliminate" "iss066.htm") + ("compiler-verbosity:like-load" "iss067.htm") + ("compiler-warning-stream" "iss068.htm") + ("complex-atan-branch-cut:tweak" "iss069.htm") + ("complex-atanh-bogus-formula:tweak-more" "iss070.htm") + ("complex-rational-result:extend" "iss071.htm") + ("compute-applicable-methods:generic" "iss072.htm") + ("concatenate-sequence:signal-error" "iss073.htm") + ("condition-accessors-setfable:no" "iss074.htm") + ("condition-restarts:buggy" "iss075.htm") + ("condition-restarts:permit-association" "iss076.htm") + ("condition-slots:hidden" "iss077.htm") + ("cons-type-specifier:add" "iss078.htm") + ("constant-circular-compilation:yes" "iss079.htm") + ("constant-collapsing:generalize" "iss080.htm") + ("constant-compilable-types:specify" "iss081.htm") + ("constant-function-compilation:no" "iss082.htm") + ("constant-modification:disallow" "iss083.htm") + ("constantp-definition:intentional" "iss084.htm") + ("constantp-environment:add-arg" "iss085.htm") + ("contagion-on-numerical-comparisons:transitive" "iss086.htm") + ("copy-symbol-copy-plist:copy-list" "iss087.htm") + ("copy-symbol-print-name:equal" "iss088.htm") + ("data-io:add-support" "iss089.htm") + ("data-types-hierarchy-underspecified" "iss090.htm") + ("debugger-hook-vs-break:clarify" "iss091.htm") + ("declaration-scope:no-hoisting" "iss092.htm") + ("declare-array-type-element-references:restrictive" "iss093.htm") + ("declare-function-ambiguity:delete-ftype-abbreviation" "iss094.htm") + ("declare-macros:flush" "iss095.htm") + ("declare-type-free:lexical" "iss096.htm") + ("decls-and-doc" "iss097.htm") + ("decode-universal-time-daylight:like-encode" "iss098.htm") + ("defconstant-special:no" "iss099.htm") + ("defgeneric-declare:allow-multiple" "iss100.htm") + ("define-compiler-macro:x3j13-nov89" "iss101.htm") + ("define-condition-syntax:incompatibly-more-like-defclass+emphasize-read-only" "iss102.htm") + ("define-method-combination-behavior:clarify" "iss103.htm") + ("defining-macros-non-top-level:allow" "iss104.htm") + ("defmacro-block-scope:excludes-bindings" "iss105.htm") + ("defmacro-lambda-list:tighten-description" "iss106.htm") + ("defmethod-declaration-scope:corresponds-to-bindings" "iss107.htm") + ("defpackage:addition" "iss108.htm") + ("defstruct-constructor-key-mixture:allow-key" "iss109.htm") + ("defstruct-constructor-options:explicit" "iss110.htm") + ("defstruct-constructor-slot-variables:not-bound" "iss111.htm") + ("defstruct-copier-argument-type:restrict" "iss112.htm") + ("defstruct-copier:argument-type" "iss113.htm") + ("defstruct-default-value-evaluation:iff-needed" "iss114.htm") + ("defstruct-include-deftype:explicitly-undefined" "iss115.htm") + ("defstruct-print-function-again:x3j13-mar-93" "iss116.htm") + ("defstruct-print-function-inheritance:yes" "iss117.htm") + ("defstruct-redefinition:error" "iss118.htm") + ("defstruct-slots-constraints-name:duplicates-error" "iss119.htm") + ("defstruct-slots-constraints-number" "iss120.htm") + ("deftype-destructuring:yes" "iss121.htm") + ("deftype-key:allow" "iss122.htm") + ("defvar-documentation:unevaluated" "iss123.htm") + ("defvar-init-time:not-delayed" "iss124.htm") + ("defvar-initialization:conservative" "iss125.htm") + ("deprecation-position:limited" "iss126.htm") + ("describe-interactive:no" "iss127.htm") + ("describe-underspecified:describe-object" "iss128.htm") + ("destructive-operations:specify" "iss129.htm") + ("destructuring-bind:new-macro" "iss130.htm") + ("disassemble-side-effect:do-not-install" "iss131.htm") + ("displaced-array-predicate:add" "iss132.htm") + ("do-symbols-block-scope:entire-form" "iss133.htm") + ("do-symbols-duplicates" "iss134.htm") + ("documentation-function-bugs:fix" "iss135.htm") + ("documentation-function-tangled:require-argument" "iss136.htm") + ("dotimes-ignore:x3j13-mar91" "iss137.htm") + ("dotted-list-arguments:clarify" "iss138.htm") + ("dotted-macro-forms:allow" "iss139.htm") + ("dribble-technique" "iss140.htm") + ("dynamic-extent-function:extend" "iss141.htm") + ("dynamic-extent:new-declaration" "iss142.htm") + ("equal-structure:maybe-status-quo" "iss143.htm") + ("error-terminology-warning:might" "iss144.htm") + ("eval-other:self-evaluate" "iss145.htm") + ("eval-top-level:load-like-compile-file" "iss146.htm") + ("eval-when-non-top-level:generalize-eval-new-keywords" "iss147.htm") + ("eval-when-obsolete-keywords:x3j13-mar-1993" "iss148.htm") + ("evalhook-step-confusion:fix" "iss149.htm") + ("evalhook-step-confusion:x3j13-nov-89" "iss150.htm") + ("exit-extent-and-condition-system:like-dynamic-bindings" "iss151.htm") + ("exit-extent:minimal" "iss152.htm") + ("expt-ratio:p.211" "iss153.htm") + ("extensions-position:documentation" "iss154.htm") + ("external-format-for-every-file-connection:minimum" "iss155.htm") + ("extra-return-values:no" "iss156.htm") + ("file-open-error:signal-file-error" "iss157.htm") + ("fixnum-non-portable:tighten-definition" "iss158.htm") + ("flet-declarations" "iss159.htm") + ("flet-declarations:allow" "iss160.htm") + ("flet-implicit-block:yes" "iss161.htm") + ("float-underflow:add-variables" "iss162.htm") + ("floating-point-condition-names:x3j13-nov-89" "iss163.htm") + ("format-atsign-colon" "iss164.htm") + ("format-colon-uparrow-scope" "iss165.htm") + ("format-comma-interval" "iss166.htm") + ("format-e-exponent-sign:force-sign" "iss167.htm") + ("format-op-c" "iss168.htm") + ("format-pretty-print:yes" "iss169.htm") + ("format-string-arguments:specify" "iss170.htm") + ("function-call-evaluation-order:more-unspecified" "iss171.htm") + ("function-composition:jan89-x3j13" "iss172.htm") + ("function-definition:jan89-x3j13" "iss173.htm") + ("function-name:large" "iss174.htm") + ("function-type" "iss175.htm") + ("function-type-argument-type-semantics:restrictive" "iss176.htm") + ("function-type-key-name:specify-keyword" "iss177.htm") + ("function-type-rest-list-element:use-actual-argument-type" "iss178.htm") + ("function-type:x3j13-march-88" "iss179.htm") + ("generalize-pretty-printer:unify" "iss180.htm") + ("generic-flet-poorly-designed:delete" "iss181.htm") + ("gensym-name-stickiness:like-teflon" "iss182.htm") + ("gentemp-bad-idea:deprecate" "iss183.htm") + ("get-macro-character-readtable:nil-standard" "iss184.htm") + ("get-setf-method-environment:add-arg" "iss185.htm") + ("hash-table-access:x3j13-mar-89" "iss186.htm") + ("hash-table-key-modification:specify" "iss187.htm") + ("hash-table-package-generators:add-with-wrapper" "iss188.htm") + ("hash-table-rehash-size-integer" "iss189.htm") + ("hash-table-size:intended-entries" "iss190.htm") + ("hash-table-tests:add-equalp" "iss191.htm") + ("ieee-atan-branch-cut:split" "iss192.htm") + ("ignore-use-terminology:value-only" "iss193.htm") + ("import-setf-symbol-package" "iss194.htm") + ("in-package-functionality:mar89-x3j13" "iss195.htm") + ("in-syntax:minimal" "iss196.htm") + ("initialization-function-keyword-checking" "iss197.htm") + ("iso-compatibility:add-substrate" "iss198.htm") + ("jun90-trivial-issues:11" "iss199.htm") + ("jun90-trivial-issues:14" "iss200.htm") + ("jun90-trivial-issues:24" "iss201.htm") + ("jun90-trivial-issues:25" "iss202.htm") + ("jun90-trivial-issues:27" "iss203.htm") + ("jun90-trivial-issues:3" "iss204.htm") + ("jun90-trivial-issues:4" "iss205.htm") + ("jun90-trivial-issues:5" "iss206.htm") + ("jun90-trivial-issues:9" "iss207.htm") + ("keyword-argument-name-package:any" "iss208.htm") + ("last-n" "iss209.htm") + ("lcm-no-arguments:1" "iss210.htm") + ("lexical-construct-global-definition:undefined" "iss211.htm") + ("lisp-package-name:common-lisp" "iss212.htm") + ("lisp-symbol-redefinition-again:more-fixes" "iss213.htm") + ("lisp-symbol-redefinition:mar89-x3j13" "iss214.htm") + ("load-objects:make-load-form" "iss215.htm") + ("load-time-eval:r**2-new-special-form" "iss216.htm") + ("load-time-eval:r**3-new-special-form" "iss217.htm") + ("load-truename:new-pathname-variables" "iss218.htm") + ("locally-top-level:special-form" "iss219.htm") + ("loop-and-discrepancy:no-reiteration" "iss220.htm") + ("loop-for-as-on-typo:fix-typo" "iss221.htm") + ("loop-initform-environment:partial-interleaving-vague" "iss222.htm") + ("loop-miscellaneous-repairs:fix" "iss223.htm") + ("loop-named-block-nil:override" "iss224.htm") + ("loop-present-symbols-typo:flush-wrong-words" "iss225.htm") + ("loop-syntax-overhaul:repair" "iss226.htm") + ("macro-as-function:disallow" "iss227.htm") + ("macro-declarations:make-explicit" "iss228.htm") + ("macro-environment-extent:dynamic" "iss229.htm") + ("macro-function-environment" "iss230.htm") + ("macro-function-environment:yes" "iss231.htm") + ("macro-subforms-top-level-p:add-constraints" "iss232.htm") + ("macroexpand-hook-default:explicitly-vague" "iss233.htm") + ("macroexpand-hook-initial-value:implementation-dependent" "iss234.htm") + ("macroexpand-return-value:true" "iss235.htm") + ("make-load-form-confusion:rewrite" "iss236.htm") + ("make-load-form-saving-slots:no-initforms" "iss237.htm") + ("make-package-use-default:implementation-dependent" "iss238.htm") + ("map-into:add-function" "iss239.htm") + ("mapping-destructive-interaction:explicitly-vague" "iss240.htm") + ("metaclass-of-system-class:unspecified" "iss241.htm") + ("method-combination-arguments:clarify" "iss242.htm") + ("method-initform:forbid-call-next-method" "iss243.htm") + ("muffle-warning-condition-argument" "iss244.htm") + ("multiple-value-setq-order:like-setf-of-values" "iss245.htm") + ("multiple-values-limit-on-variables:undefined" "iss246.htm") + ("nintersection-destruction" "iss247.htm") + ("nintersection-destruction:revert" "iss248.htm") + ("not-and-null-return-value:x3j13-mar-93" "iss249.htm") + ("nth-value:add" "iss250.htm") + ("optimize-debug-info:new-quality" "iss251.htm") + ("package-clutter:reduce" "iss252.htm") + ("package-deletion:new-function" "iss253.htm") + ("package-function-consistency:more-permissive" "iss254.htm") + ("parse-error-stream:split-types" "iss255.htm") + ("pathname-component-case:keyword-argument" "iss256.htm") + ("pathname-component-value:specify" "iss257.htm") + ("pathname-host-parsing:recognize-logical-host-names" "iss258.htm") + ("pathname-logical:add" "iss259.htm") + ("pathname-print-read:sharpsign-p" "iss260.htm") + ("pathname-stream" "iss261.htm") + ("pathname-stream:files-or-synonym" "iss262.htm") + ("pathname-subdirectory-list:new-representation" "iss263.htm") + ("pathname-symbol" "iss264.htm") + ("pathname-syntax-error-time:explicitly-vague" "iss265.htm") + ("pathname-unspecific-component:new-token" "iss266.htm") + ("pathname-wild:new-functions" "iss267.htm") + ("peek-char-read-char-echo:first-read-char" "iss268.htm") + ("plist-duplicates:allow" "iss269.htm") + ("pretty-print-interface" "iss270.htm") + ("princ-readably:x3j13-dec-91" "iss271.htm") + ("print-case-behavior:clarify" "iss272.htm") + ("print-case-print-escape-interaction:vertical-bar-rule-no-upcase" "iss273.htm") + ("print-circle-shared:respect-print-circle" "iss274.htm") + ("print-circle-structure:user-functions-work" "iss275.htm") + ("print-readably-behavior:clarify" "iss276.htm") + ("printer-whitespace:just-one-space" "iss277.htm") + ("proclaim-etc-in-compile-file:new-macro" "iss278.htm") + ("push-evaluation-order:first-item" "iss279.htm") + ("push-evaluation-order:item-first" "iss280.htm") + ("pushnew-store-required:unspecified" "iss281.htm") + ("quote-semantics:no-copying" "iss282.htm") + ("range-of-count-keyword:nil-or-integer" "iss283.htm") + ("range-of-start-and-end-parameters:integer-and-integer-nil" "iss284.htm") + ("read-and-write-bytes:new-functions" "iss285.htm") + ("read-case-sensitivity:readtable-keywords" "iss286.htm") + ("read-modify-write-evaluation-order:delayed-access-stores" "iss287.htm") + ("read-suppress-confusing:generalize" "iss288.htm") + ("reader-error:new-type" "iss289.htm") + ("real-number-type:x3j13-mar-89" "iss290.htm") + ("recursive-deftype:explicitly-vague" "iss291.htm") + ("reduce-argument-extraction" "iss292.htm") + ("remf-destruction-unspecified:x3j13-mar-89" "iss293.htm") + ("require-pathname-defaults-again:x3j13-dec-91" "iss294.htm") + ("require-pathname-defaults-yet-again:restore-argument" "iss295.htm") + ("require-pathname-defaults:eliminate" "iss296.htm") + ("rest-list-allocation:may-share" "iss297.htm") + ("result-lists-shared:specify" "iss298.htm") + ("return-values-unspecified:specify" "iss299.htm") + ("room-default-argument:new-value" "iss300.htm") + ("self-modifying-code:forbid" "iss301.htm") + ("sequence-type-length:must-match" "iss302.htm") + ("setf-apply-expansion:ignore-expander" "iss303.htm") + ("setf-find-class:allow-nil" "iss304.htm") + ("setf-functions-again:minimal-changes" "iss305.htm") + ("setf-get-default:evaluated-but-ignored" "iss306.htm") + ("setf-macro-expansion:last" "iss307.htm") + ("setf-method-vs-setf-method:rename-old-terms" "iss308.htm") + ("setf-multiple-store-variables:allow" "iss309.htm") + ("setf-of-apply:only-aref-and-friends" "iss310.htm") + ("setf-of-values:add" "iss311.htm") + ("setf-sub-methods:delayed-access-stores" "iss312.htm") + ("shadow-already-present" "iss313.htm") + ("shadow-already-present:works" "iss314.htm") + ("sharp-comma-confusion:remove" "iss315.htm") + ("sharp-o-foobar:consequences-undefined" "iss316.htm") + ("sharp-star-delimiter:normal-delimiter" "iss317.htm") + ("sharpsign-plus-minus-package:keyword" "iss318.htm") + ("slot-missing-values:specify" "iss319.htm") + ("slot-value-metaclasses:less-minimal" "iss320.htm") + ("special-form-p-misnomer:rename" "iss321.htm") + ("special-type-shadowing:clarify" "iss322.htm") + ("standard-input-initial-binding:defined-contracts" "iss323.htm") + ("standard-repertoire-gratuitous:rename" "iss324.htm") + ("step-environment:current" "iss325.htm") + ("step-minimal:permit-progn" "iss326.htm") + ("stream-access:add-types-accessors" "iss327.htm") + ("stream-capabilities:interactive-stream-p" "iss328.htm") + ("string-coercion:make-consistent" "iss329.htm") + ("string-output-stream-bashing:undefined" "iss330.htm") + ("structure-read-print-syntax:keywords" "iss331.htm") + ("subseq-out-of-bounds" "iss332.htm") + ("subseq-out-of-bounds:is-an-error" "iss333.htm") + ("subsetting-position:none" "iss334.htm") + ("subtypep-environment:add-arg" "iss335.htm") + ("subtypep-too-vague:clarify-more" "iss336.htm") + ("sxhash-definition:similar-for-sxhash" "iss337.htm") + ("symbol-macrolet-declare:allow" "iss338.htm") + ("symbol-macrolet-semantics:special-form" "iss339.htm") + ("symbol-macrolet-type-declaration:no" "iss340.htm") + ("symbol-macros-and-proclaimed-specials:signals-an-error" "iss341.htm") + ("symbol-print-escape-behavior:clarify" "iss342.htm") + ("syntactic-environment-access:retracted-mar91" "iss343.htm") + ("tagbody-tag-expansion:no" "iss344.htm") + ("tailp-nil:t" "iss345.htm") + ("test-not-if-not:flush-all" "iss346.htm") + ("the-ambiguity:for-declaration" "iss347.htm") + ("the-values:return-number-received" "iss348.htm") + ("time-zone-non-integer:allow" "iss349.htm") + ("type-declaration-abbreviation:allow-all" "iss350.htm") + ("type-of-and-predefined-classes:type-of-handles-floats" "iss351.htm") + ("type-of-and-predefined-classes:unify-and-extend" "iss352.htm") + ("type-of-underconstrained:add-constraints" "iss353.htm") + ("type-specifier-abbreviation:x3j13-jun90-guess" "iss354.htm") + ("undefined-variables-and-functions:compromise" "iss355.htm") + ("uninitialized-elements:consequences-undefined" "iss356.htm") + ("unread-char-after-peek-char:dont-allow" "iss357.htm") + ("unsolicited-messages:not-to-system-user-streams" "iss358.htm") + ("variable-list-asymmetry:symmetrize" "iss359.htm") + ("with-added-methods:delete" "iss360.htm") + ("with-compilation-unit:new-macro" "iss361.htm") + ("with-open-file-does-not-exist:stream-is-nil" "iss362.htm") + ("with-open-file-setq:explicitly-vague" "iss363.htm") + ("with-open-file-stream-extent:dynamic-extent" "iss364.htm") + ("with-output-to-string-append-style:vector-push-extend" "iss365.htm") + ("with-standard-io-syntax-readtable:x3j13-mar-91" "iss366.htm")))) + +(defun common-lisp-issuex (issue-name) + (let ((symbol + (intern (downcase issue-name) common-lisp-hyperspec-issuex-symbols))) + (concat common-lisp-hyperspec-root "Issues/" (symbol-value symbol)))) + (provide 'hyperspec) ;;; hyperspec.el ends here From lgorrie at common-lisp.net Mon Jun 28 10:22:28 2004 From: lgorrie at common-lisp.net (Luke Gorrie) Date: Mon, 28 Jun 2004 03:22:28 -0700 Subject: [slime-cvs] CVS update: slime/slime.el Message-ID: Update of /project/slime/cvsroot/slime In directory common-lisp.net:/tmp/cvs-serv7729 Modified Files: slime.el Log Message: >From Christohpe Rhodes: Support for new SBCL reference types: :ansi-cl :glossary :ansi-cl :issue Date: Mon Jun 28 03:22:27 2004 Author: lgorrie Index: slime/slime.el diff -u slime/slime.el:1.339 slime/slime.el:1.340 --- slime/slime.el:1.339 Sun Jun 27 08:04:07 2004 +++ slime/slime.el Mon Jun 28 03:22:27 2004 @@ -5457,7 +5457,7 @@ (and (eq where :ansi-cl) (symbolp type) (member (slime-cl-symbol-name type) - '("function" "special-operator" "macro" "section")))) + '("function" "special-operator" "macro" "section" "glossary" "issue")))) `(sldb-default-action sldb-lookup-reference sldb-reference ,ref face sldb-reference-face @@ -5485,6 +5485,10 @@ (case type (:section (browse-url (funcall common-lisp-hyperspec-section-fun what))) + (:glossary + (browse-url (funcall common-lisp-glossary-fun what))) + (:issue + (browse-url (funcall 'common-lisp-issuex what))) (t (hyperspec-lookup (if (symbolp what) (slime-cl-symbol-name what) From lgorrie at common-lisp.net Mon Jun 28 10:22:38 2004 From: lgorrie at common-lisp.net (Luke Gorrie) Date: Mon, 28 Jun 2004 03:22:38 -0700 Subject: [slime-cvs] CVS update: slime/ChangeLog Message-ID: Update of /project/slime/cvsroot/slime In directory common-lisp.net:/tmp/cvs-serv8003 Modified Files: ChangeLog Log Message: Date: Mon Jun 28 03:22:38 2004 Author: lgorrie Index: slime/ChangeLog diff -u slime/ChangeLog:1.431 slime/ChangeLog:1.432 --- slime/ChangeLog:1.431 Sun Jun 27 08:23:54 2004 +++ slime/ChangeLog Mon Jun 28 03:22:38 2004 @@ -1,3 +1,23 @@ +2004-06-28 Christophe Rhodes + + * hyperspec.el: add support for issue cross-reference lookups, + strongly inspired by hyperspec symbol lookup. + (common-lisp-hyperspec-issuex-table, + common-lisp-hyperspec-issuex-symbols): new variables + (common-lisp-issuex): new function + + * slime.el (sldb-format-reference-node, sldb-lookup-reference): + (sldb-reference-properties): use new support for issue lookups + to support :ansi-cl :issue reference types. + + * hyperspec.el: add support for glossary lookups. + (common-lisp-glossary-fun): new variable + (common-lisp-glossary-4.0, common-lisp-glossary-6.0): new functions + + * slime.el (sldb-format-reference-node, sldb-lookup-reference): + (sldb-reference-properties): use new support for glossary lookupts + to support :ansi-cl :glossary reference types. + 2004-06-27 Helmut Eller * doc/slime.texi: Remove macros from chapter and section headings @@ -59,7 +79,7 @@ 2004-06-24 Brian Downing - * slime.el (slime-repl-send-input): Fixed a subtle difference in + * slime.el (slime-repl-send-input): Fixed a subtle difference in sending input to the Lisp introduced in 1.316. The newline was not getting sent, resulting in the Lisp constantly asking for more read data. I believe the code has been adjusted to behave the From lgorrie at common-lisp.net Mon Jun 28 11:05:48 2004 From: lgorrie at common-lisp.net (Luke Gorrie) Date: Mon, 28 Jun 2004 04:05:48 -0700 Subject: [slime-cvs] CVS update: slime/hyperspec.el Message-ID: Update of /project/slime/cvsroot/slime In directory common-lisp.net:/tmp/cvs-serv2453 Modified Files: hyperspec.el Log Message: (common-lisp-hyperspec-format): This command now works at the end of the buffer, fixed `char-after' usage as suggested by Johan Bockg?rd. Date: Mon Jun 28 04:05:48 2004 Author: lgorrie Index: slime/hyperspec.el diff -u slime/hyperspec.el:1.4 slime/hyperspec.el:1.5 --- slime/hyperspec.el:1.4 Mon Jun 28 03:19:11 2004 +++ slime/hyperspec.el Mon Jun 28 04:05:48 2004 @@ -1153,7 +1153,8 @@ (defun common-lisp-hyperspec-format (character-name) (interactive - (list (let ((char-at-point (char-to-string (char-after (point))))) + (list (let ((char-at-point + (ignore-errors (char-to-string (char-after (point)))))) (if (and char-at-point (intern-soft (upcase char-at-point) common-lisp-hyperspec-format-characters)) From lgorrie at common-lisp.net Mon Jun 28 11:06:00 2004 From: lgorrie at common-lisp.net (Luke Gorrie) Date: Mon, 28 Jun 2004 04:06:00 -0700 Subject: [slime-cvs] CVS update: slime/ChangeLog Message-ID: Update of /project/slime/cvsroot/slime In directory common-lisp.net:/tmp/cvs-serv2572 Modified Files: ChangeLog Log Message: Date: Mon Jun 28 04:06:00 2004 Author: lgorrie Index: slime/ChangeLog diff -u slime/ChangeLog:1.432 slime/ChangeLog:1.433 --- slime/ChangeLog:1.432 Mon Jun 28 03:22:38 2004 +++ slime/ChangeLog Mon Jun 28 04:06:00 2004 @@ -1,3 +1,9 @@ +2004-06-28 Luke Gorrie + + * hyperspec.el (common-lisp-hyperspec-format): This command now + works at the end of the buffer, fixed `char-after' usage as + suggested by Johan Bockg?rd. + 2004-06-28 Christophe Rhodes * hyperspec.el: add support for issue cross-reference lookups, From lgorrie at common-lisp.net Mon Jun 28 12:40:50 2004 From: lgorrie at common-lisp.net (Luke Gorrie) Date: Mon, 28 Jun 2004 05:40:50 -0700 Subject: [slime-cvs] CVS update: slime/slime.el Message-ID: Update of /project/slime/cvsroot/slime In directory common-lisp.net:/tmp/cvs-serv11079 Modified Files: slime.el Log Message: Events in the *slime-events* buffer are now exact on-the-wire messages, without including e.g. Elisp continuation functions. This is easier for debugging I think. Date: Mon Jun 28 05:40:50 2004 Author: lgorrie Index: slime/slime.el diff -u slime/slime.el:1.340 slime/slime.el:1.341 --- slime/slime.el:1.340 Mon Jun 28 03:22:27 2004 +++ slime/slime.el Mon Jun 28 05:40:49 2004 @@ -1270,6 +1270,7 @@ EVAL'd by Lisp." (let* ((msg (concat (slime-prin1-to-string sexp) "\n")) (string (concat (slime-net-enc3 (length msg)) msg))) + (slime-log-event sexp) (process-send-string proc (string-make-unibyte string)))) (defun slime-net-close (process) @@ -1309,7 +1310,9 @@ (sleep-for 2) (ignore-errors (slime-net-close proc)) (error "PANIC!"))))) - (save-current-buffer (slime-dispatch-event event proc)))))) + (save-current-buffer + (slime-log-event event) + (slime-dispatch-event event proc)))))) (dolist (p slime-net-processes) (with-current-buffer (process-buffer p) (when (slime-net-have-input-p) @@ -1533,7 +1536,6 @@ (defun slime-dispatch-event (event &optional process) (let ((slime-dispatching-connection (or process (slime-connection)))) - (slime-log-event event) (destructure-case event ((:read-output output) (slime-output-string output)) From lgorrie at common-lisp.net Mon Jun 28 12:42:50 2004 From: lgorrie at common-lisp.net (Luke Gorrie) Date: Mon, 28 Jun 2004 05:42:50 -0700 Subject: [slime-cvs] CVS update: slime/swank-allegro.lisp Message-ID: Update of /project/slime/cvsroot/slime In directory common-lisp.net:/tmp/cvs-serv14492 Modified Files: swank-allegro.lisp Log Message: (compute-backtrace): Only include frames satisfying `debugger:frame-visible-p'. I did this as a lame workaround for a problem where `output-frame' was segfaulting on certain frames, and those frames happened not to be visible-p. I don't know if it really fixes anything. Date: Mon Jun 28 05:42:50 2004 Author: lgorrie Index: slime/swank-allegro.lisp diff -u slime/swank-allegro.lisp:1.40 slime/swank-allegro.lisp:1.41 --- slime/swank-allegro.lisp:1.40 Sun Jun 27 08:00:23 2004 +++ slime/swank-allegro.lisp Mon Jun 28 05:42:50 2004 @@ -135,7 +135,7 @@ (loop for f = (nth-frame start) then (excl::int-next-older-frame f) for i from start below end while f - collect f))) + when (debugger:frame-visible-p f) collect f))) (defimplementation print-frame (frame stream) (debugger:output-frame stream frame :moderate)) From lgorrie at common-lisp.net Mon Jun 28 12:43:23 2004 From: lgorrie at common-lisp.net (Luke Gorrie) Date: Mon, 28 Jun 2004 05:43:23 -0700 Subject: [slime-cvs] CVS update: slime/ChangeLog Message-ID: Update of /project/slime/cvsroot/slime In directory common-lisp.net:/tmp/cvs-serv16222 Modified Files: ChangeLog Log Message: Date: Mon Jun 28 05:43:23 2004 Author: lgorrie Index: slime/ChangeLog diff -u slime/ChangeLog:1.433 slime/ChangeLog:1.434 --- slime/ChangeLog:1.433 Mon Jun 28 04:06:00 2004 +++ slime/ChangeLog Mon Jun 28 05:43:22 2004 @@ -1,5 +1,15 @@ 2004-06-28 Luke Gorrie + * slime.el: Events in the *slime-events* buffer are now exact + on-the-wire messages, without including e.g. Elisp continuation + functions. This is easier for debugging I think. + + * swank-allegro.lisp (compute-backtrace): Only include frames + satisfying `debugger:frame-visible-p'. I did this as a lame + workaround for a problem where `output-frame' was segfaulting on + certain frames, and those frames happened not to be visible-p. I + don't know if it really fixes anything. + * hyperspec.el (common-lisp-hyperspec-format): This command now works at the end of the buffer, fixed `char-after' usage as suggested by Johan Bockg?rd. From heller at common-lisp.net Mon Jun 28 16:02:54 2004 From: heller at common-lisp.net (Helmut Eller) Date: Mon, 28 Jun 2004 09:02:54 -0700 Subject: [slime-cvs] CVS update: slime/slime.el Message-ID: Update of /project/slime/cvsroot/slime In directory common-lisp.net:/tmp/cvs-serv11732 Modified Files: slime.el Log Message: (slime-buffer-package): Return the cached package if find anything sensible as we did earlier versions. The Lisp side will now fall back to an existing package if the one supplied by Emacs doesn't exist. Using the cached version is also necessary for some commands in the apropos buffer. (sldb-insert-frame): Set the default-action property; now RET toggles the details on frame lines. (sldb-toggle-details): Preserve the current column. (slime-inspector-buffer, slime-saved-window-config) (slime-inspector-quit): Save and the window configuration. (slime-highlight-suppressed-forms, slime-search-suppressed-forms): Display expressions with reader conditionals (#+/#-) where the test is false in font-lock-comment-face. No implemented for XEmacs. (repl-return): New test. Date: Mon Jun 28 09:02:54 2004 Author: heller Index: slime/slime.el diff -u slime/slime.el:1.341 slime/slime.el:1.342 --- slime/slime.el:1.341 Mon Jun 28 05:40:49 2004 +++ slime/slime.el Mon Jun 28 09:02:54 2004 @@ -728,9 +728,7 @@ (force-mode-line-update))) string) (t - (if dont-cache - "COMMON-LISP-USER" - slime-buffer-package)))))) + slime-buffer-package))))) (defun slime-find-buffer-package () "Figure out which Lisp package the current buffer is associated with." @@ -5526,12 +5524,14 @@ collect frame) frames)) -(defun sldb-insert-frame (frame) +(defun sldb-insert-frame (frame &optional detailedp) (destructuring-bind (number string) frame (slime-insert-propertized - `(frame ,frame) + `(frame ,frame sldb-default-action sldb-toggle-details) " " (in-sldb-face frame-label (format "%d" number)) ": " - (in-sldb-face frame-line string) + (if detailedp + (in-sldb-face detailed-frame-line string) + (in-sldb-face frame-line string)) "\n"))) (defun sldb-insert-frames (frames maximum-length) @@ -5664,10 +5664,12 @@ The details include local variable bindings and CATCH-tags." (interactive) (sldb-frame-number-at-point) - (let ((inhibit-read-only t)) + (let ((inhibit-read-only t) + (column (current-column))) (if (or on (not (sldb-frame-details-visible-p))) (sldb-show-frame-details) - (sldb-hide-frame-details)))) + (sldb-hide-frame-details)) + (move-to-column column))) (defun sldb-frame-details-visible-p () (and (get-text-property (point) 'frame) @@ -5684,11 +5686,9 @@ (indent1 " ") (indent2 " ")) (delete-region start end) - (slime-propertize-region (plist-put props 'details-visible-p t) - (insert " " - (in-sldb-face frame-label (format "%d" frame-number)) ": " - (in-sldb-face detailed-frame-line (second frame)) "\n" - indent1 (in-sldb-face section "Locals:") "\n") + (slime-propertize-region `(frame ,frame details-visible-p t) + (sldb-insert-frame frame t) + (insert indent1 (in-sldb-face section "Locals:") "\n") (sldb-insert-locals frame-number indent2) (when sldb-show-catch-tags (let ((catchers (sldb-catch-tags frame-number))) @@ -6109,6 +6109,7 @@ :group 'slime-inspector) (defvar slime-inspector-mark-stack '()) +(defvar slime-saved-window-config) (defun slime-inspect (string) "Eval an expression and inspect the result." @@ -6129,10 +6130,12 @@ (setq slime-inspector-mark-stack '()) (slime-mode t) (slime-inspector-mode) + (make-local-variable 'slime-saved-window-config) + (setq slime-saved-window-config (current-window-configuration)) (current-buffer)))) -(defun slime-inspector-fontify (face string) - (slime-add-face (intern (format "slime-inspector-%s-face" face)) string)) +(defmacro slime-inspector-fontify (face string) + `(slime-add-face ',(intern (format "slime-inspector-%s-face" face)) ,string)) (defun slime-open-inspector (inspected-parts &optional point) "Display INSPECTED-PARTS in a new inspector window. @@ -6142,7 +6145,7 @@ (erase-buffer) (destructuring-bind (&key text type primitive-type parts) inspected-parts (macrolet ((fontify (face string) - `(slime-inspector-fontify ',face ,string))) + `(slime-inspector-fontify ,face ,string))) (insert (fontify topline text)) (while (eq (char-before) ?\n) (backward-delete-char 1)) (insert "\n" @@ -6193,6 +6196,7 @@ (defun slime-inspector-quit () (interactive) (slime-eval-async `(swank:quit-inspector) nil (lambda (_))) + (set-window-configuration slime-saved-window-config) (kill-buffer (current-buffer))) (defun slime-inspector-describe () @@ -6424,6 +6428,48 @@ (ignore-errors (end-of-defun) t)) do (insert ")"))) + + +;;; Font Lock + +(defcustom slime-highlight-suppressed-forms t + "If enabled highlight reader conditionalized forms if the test is false." + :type '(choice (const :tag "Enable" t) (const :tag "Disable" nil)) + :group 'slime) + +(defun slime-search-suppressed-forms (limit) + "Find reader conditionalized forms where the test is false." + (when (and slime-highlight-suppressed-forms + (slime-connected-p) + (re-search-forward "[ \n\t\r]#[-+]" limit t)) + (ignore-errors + (let* ((char (char-before)) + (e (read (current-buffer))) + (val (slime-eval-feature-conditional e))) + (when (<= (point) limit) + (if (or (and (eq char ?+) (not val)) + (and (eq char ?-) val)) + (let ((start (point))) + (forward-sexp) + (assert (<= (point) limit)) + (let ((md (match-data))) + (fill md nil) + (setf (first md) start) + (setf (second md) (point)) + (set-match-data md) + t)) + (slime-search-suppressed-forms limit))))))) + +;; XXX add XEmacs compatibility +(defun slime-activate-font-lock-magic () + (font-lock-add-keywords + 'lisp-mode + '((slime-search-suppressed-forms 0 font-lock-comment-face t)))) + +(when (and (fboundp 'font-lock-add-keywords) + slime-highlight-suppressed-forms) + (slime-activate-font-lock-magic)) + ;;; Indentation @@ -7024,6 +7070,37 @@ (slime-test-expect "Buffer contains result" result-contents (buffer-string)))) +(def-slime-test repl-return + (before after result-contents) + "Test if slime-repl-return sends the correct protion to Lisp even +if point is not at the end of the line." + '(("(+ 1 2)" "" "SWANK> (+ 1 2) +3 +SWANK> ") +("(+ 1 " "2)" "SWANK> (+ 1 2) +3 +SWANK> ") + +("(+ 1\n" "2)" "SWANK> (+ 1 +2) +3 +SWANK> ") + +) + (with-current-buffer (slime-output-buffer) + (setf (slime-lisp-package) "SWANK")) + (kill-buffer (slime-output-buffer)) + (with-current-buffer (slime-output-buffer) + (insert before) + (save-excursion (insert after)) + (slime-test-expect "Buffer contains input" + (concat "SWANK> " before after) + (buffer-string)) + (call-interactively 'slime-repl-return) + (slime-sync-to-top-level 5) + (slime-test-expect "Buffer contains result" + result-contents (buffer-string)))) + (def-slime-test repl-read (prompt input result-contents) "Test simple commands in the minibuffer." @@ -7116,7 +7193,7 @@ (with-current-buffer (sldb-get-default-buffer) (sldb-quit)) (slime-sync-to-top-level 5)) - + ;;; Portability library From heller at common-lisp.net Mon Jun 28 16:03:52 2004 From: heller at common-lisp.net (Helmut Eller) Date: Mon, 28 Jun 2004 09:03:52 -0700 Subject: [slime-cvs] CVS update: slime/swank-allegro.lisp Message-ID: Update of /project/slime/cvsroot/slime In directory common-lisp.net:/tmp/cvs-serv14784 Modified Files: swank-allegro.lisp Log Message: (nth-frame): Skip frames where frame-visible-p is false. Date: Mon Jun 28 09:03:52 2004 Author: heller Index: slime/swank-allegro.lisp diff -u slime/swank-allegro.lisp:1.41 slime/swank-allegro.lisp:1.42 --- slime/swank-allegro.lisp:1.41 Mon Jun 28 05:42:50 2004 +++ slime/swank-allegro.lisp Mon Jun 28 09:03:52 2004 @@ -125,17 +125,23 @@ (excl::*break-hook* nil)) (funcall debugger-loop-fn))) +(defun next-frame (frame) + (let ((next (excl::int-next-older-frame frame))) + (cond ((not next) nil) + ((debugger:frame-visible-p next) next) + (t (next-frame next))))) + (defun nth-frame (index) - (do ((frame *sldb-topframe* (excl::int-next-older-frame frame)) + (do ((frame *sldb-topframe* (next-frame frame)) (i index (1- i))) ((zerop i) frame))) (defimplementation compute-backtrace (start end) (let ((end (or end most-positive-fixnum))) - (loop for f = (nth-frame start) then (excl::int-next-older-frame f) + (loop for f = (nth-frame start) then (next-frame f) for i from start below end while f - when (debugger:frame-visible-p f) collect f))) + collect f))) (defimplementation print-frame (frame stream) (debugger:output-frame stream frame :moderate)) From heller at common-lisp.net Mon Jun 28 16:09:33 2004 From: heller at common-lisp.net (Helmut Eller) Date: Mon, 28 Jun 2004 09:09:33 -0700 Subject: [slime-cvs] CVS update: slime/ChangeLog Message-ID: Update of /project/slime/cvsroot/slime In directory common-lisp.net:/tmp/cvs-serv6705 Modified Files: ChangeLog Log Message: *** empty log message *** Date: Mon Jun 28 09:09:33 2004 Author: heller Index: slime/ChangeLog diff -u slime/ChangeLog:1.434 slime/ChangeLog:1.435 --- slime/ChangeLog:1.434 Mon Jun 28 05:43:22 2004 +++ slime/ChangeLog Mon Jun 28 09:09:33 2004 @@ -1,3 +1,24 @@ +2004-06-28 Helmut Eller + + * swank-allegro.lisp (nth-frame): Skip frames where + frame-visible-p is false. + + * slime.el (slime-buffer-package): Return the cached package if + can't something more sensible; this reverts a previous change. + The Lisp side will now fall back to an existing package if the one + supplied by Emacs doesn't exist. Using the cached version is also + necessary for some commands in the apropos buffer. + (sldb-insert-frame): Set the default-action property; pressing RET + on frame lines now shows/hides details. + (sldb-toggle-details): Preserve the current column. + (slime-inspector-buffer, slime-saved-window-config) + (slime-inspector-quit): Save and restore the window configuration. + (slime-highlight-suppressed-forms, slime-search-suppressed-forms): + Display expressions with reader conditionals (#+/#-) where the + test is false in font-lock-comment-face. No implemented for + XEmacs. + (repl-return): New test. + 2004-06-28 Luke Gorrie * slime.el: Events in the *slime-events* buffer are now exact From asimon at common-lisp.net Mon Jun 28 17:46:13 2004 From: asimon at common-lisp.net (Andras Simon) Date: Mon, 28 Jun 2004 10:46:13 -0700 Subject: [slime-cvs] CVS update: slime/swank-abcl.lisp Message-ID: Update of /project/slime/cvsroot/slime In directory common-lisp.net:/tmp/cvs-serv30944 Modified Files: swank-abcl.lisp Log Message: use thread names Date: Mon Jun 28 10:46:13 2004 Author: asimon Index: slime/swank-abcl.lisp diff -u slime/swank-abcl.lisp:1.7 slime/swank-abcl.lisp:1.8 --- slime/swank-abcl.lisp:1.7 Sun Jun 27 10:10:33 2004 +++ slime/swank-abcl.lisp Mon Jun 28 10:46:13 2004 @@ -310,7 +310,7 @@ #+nil(mp:start-scheduler)) (defimplementation spawn (fn &key name) - (ext:make-thread (lambda () (funcall fn)))) + (ext:make-thread (lambda () (funcall fn)) :name name)) (defvar *thread-props-lock* (ext:make-thread-lock)) @@ -331,7 +331,7 @@ (getf (gethash thread *thread-props*) 'id)))) (defimplementation thread-name (thread) - (princ-to-string thread)) + (ext:thread-name thread)) (defimplementation thread-status (thread) (format nil "Thread is ~:[dead~;alive~]" (ext:thread-alive-p thread))) From lgorrie at common-lisp.net Mon Jun 28 21:05:16 2004 From: lgorrie at common-lisp.net (Luke Gorrie) Date: Mon, 28 Jun 2004 14:05:16 -0700 Subject: [slime-cvs] CVS update: slime/slime.el Message-ID: Update of /project/slime/cvsroot/slime In directory common-lisp.net:/tmp/cvs-serv12241 Modified Files: slime.el Log Message: (slime-doc-map): New keymap for documentation commands. These all use the `C-c C-d' prefix, followed by: a - apropos p - apropos-package z - apropos-all d - describe-symbol f - describe-function h - hyperspec lookup ~ - hyperspec lookup of a format character The final keystroke is bound both unmodified and with control, so both `C-c C-d a' and `C-c C-d C-a' will make an apropos search. The exception is hyperspec-lookup, because it's nice to leave C-h unbound so that `C-c C-d C-h' will summarise the documentation bindings. Date: Mon Jun 28 14:05:16 2004 Author: lgorrie Index: slime/slime.el diff -u slime/slime.el:1.342 slime/slime.el:1.343 --- slime/slime.el:1.342 Mon Jun 28 09:02:54 2004 +++ slime/slime.el Mon Jun 28 14:05:16 2004 @@ -466,20 +466,15 @@ ;; Documentation (" " slime-space :inferior t) ("\C-s" slime-insert-arglist :prefixed t :inferior t) - ("\C-d" slime-describe-symbol :prefixed t :inferior t :sldb t) ("\C-f" slime-describe-function :prefixed t :inferior t :sldb t) ("\M-d" slime-disassemble-symbol :prefixed t :inferior t :sldb t) ("\C-t" slime-toggle-trace-fdefinition :prefixed t :sldb t) ("\C-u" slime-undefine-function :prefixed t) - ("\C-a" slime-apropos :prefixed t :inferior t :sldb t) - ("\M-a" slime-apropos-all :prefixed t :inferior t :sldb t) ;; Kinda crappy binding. Maybe we should introduce some extra ;; prefixes for documentation commands. -luke (17/Jan/2004) - ("P" slime-apropos-package :prefixed t :inferior t :sldb t) ("\C-m" slime-macroexpand-1 :prefixed t :inferior t) ("\M-m" slime-macroexpand-all :prefixed t :inferior t) ("\M-0" slime-restore-window-configuration :prefixed t :inferior t) - ("\C-h" slime-hyperspec-lookup :prefixed t :inferior t :sldb t) ([(control meta ?\.)] slime-next-location :inferior t) ;; Emacs20 on LinuxPPC signals a ;; "Invalid character: 400000040, 2147479172, 0xffffffd8" @@ -501,6 +496,18 @@ ("\C-xt" slime-list-threads :prefixed t :inferior t :sldb t) ("\C-xc" slime-list-connections :prefixed t :inferior t :sldb t))) +(defvar slime-doc-map (make-sparse-keymap) + "Keymap for documentation commands. Bound to a prefix key.") + +(defvar slime-doc-bindings + '((?a slime-apropos) + (?z slime-apropos-all) + (?p slime-apropos-package) + (?d slime-describe-symbol) + (?f slime-describe-function) + (?h slime-hyperspec-lookup) + (?~ common-lisp-hyperspec-format))) + ;; Maybe a good idea, maybe not.. (defvar slime-prefix-key "\C-c" "The prefix key to use in SLIME keybinding sequences.") @@ -525,7 +532,23 @@ (define-key inferior-slime-mode-map [(control return)] 'inferior-slime-closing-return) (define-key inferior-slime-mode-map - [(meta control ?m)] 'inferior-slime-closing-return)) + [(meta control ?m)] 'inferior-slime-closing-return) + ;; Documentation + (setq slime-doc-map (make-sparse-keymap)) + (loop for (key command) in slime-doc-bindings + do (progn + ;; We bind both unmodified and with control. + (define-key slime-doc-map (string key) command) + (unless (equal key ?h) ; But don't bind C-h + (let ((modified (slime-control-modified-char key))) + (define-key slime-doc-map (string modified) command))))) + ;; C-c C-d is the prefix for the doc map. + (slime-define-key "\C-d" slime-doc-map :prefixed t :inferior t)) + +(defun slime-control-modified-char (char) + "Return the control-modified version of CHAR." + ;; Maybe better to just bitmask it? + (car (read-from-string (format "?\\C-%c" char)))) (slime-init-keymaps) @@ -2482,6 +2505,7 @@ ;("\t" 'slime-complete-symbol) ("\t" 'slime-indent-and-complete-symbol) (" " 'slime-space) + ("\C-c\C-d" slime-doc-map) ("\C-\M-x" 'slime-eval-defun) ("\C-c\C-o" 'slime-repl-clear-output) ("\C-c\C-t" 'slime-repl-clear-buffer) From lgorrie at common-lisp.net Mon Jun 28 21:05:28 2004 From: lgorrie at common-lisp.net (Luke Gorrie) Date: Mon, 28 Jun 2004 14:05:28 -0700 Subject: [slime-cvs] CVS update: slime/ChangeLog Message-ID: Update of /project/slime/cvsroot/slime In directory common-lisp.net:/tmp/cvs-serv12685 Modified Files: ChangeLog Log Message: Date: Mon Jun 28 14:05:28 2004 Author: lgorrie Index: slime/ChangeLog diff -u slime/ChangeLog:1.435 slime/ChangeLog:1.436 --- slime/ChangeLog:1.435 Mon Jun 28 09:09:33 2004 +++ slime/ChangeLog Mon Jun 28 14:05:28 2004 @@ -1,3 +1,20 @@ +2004-06-28 Luke Gorrie + + * slime.el (slime-doc-map): New keymap for documentation + commands. These all use the `C-c C-d' prefix, followed by: + a - apropos + p - apropos-package + z - apropos-all + d - describe-symbol + f - describe-function + h - hyperspec lookup + ~ - hyperspec lookup of a format character + The final keystroke is bound both unmodified and with control, so + both `C-c C-d a' and `C-c C-d C-a' will make an apropos + search. The exception is hyperspec-lookup, because it's nice to + leave C-h unbound so that `C-c C-d C-h' will summarise the + documentation bindings. + 2004-06-28 Helmut Eller * swank-allegro.lisp (nth-frame): Skip frames where From mbaringer at common-lisp.net Tue Jun 29 08:12:45 2004 From: mbaringer at common-lisp.net (Marco Baringer) Date: Tue, 29 Jun 2004 01:12:45 -0700 Subject: [slime-cvs] CVS update: slime/swank.lisp slime/slime.el slime/ChangeLog Message-ID: Update of /project/slime/cvsroot/slime In directory common-lisp.net:/tmp/cvs-serv4073 Modified Files: swank.lisp slime.el ChangeLog Log Message: 2004-06-28 Thomas F. Burdick * swank.lisp (inspector-nth-part): * slime.el (slime-inspector-copy-down, slime-inspector-mode-map): Added copy-down command (M-RET) to easily move an object from the inspector to the repl. Date: Tue Jun 29 01:12:45 2004 Author: mbaringer Index: slime/swank.lisp diff -u slime/swank.lisp:1.204 slime/swank.lisp:1.205 --- slime/swank.lisp:1.204 Sun Jun 27 07:58:51 2004 +++ slime/swank.lisp Tue Jun 29 01:12:44 2004 @@ -2432,12 +2432,12 @@ collect (cons (princ-to-string label) (print-part-to-string value))))))) -(defun nth-part (index) +(defslimefun inspector-nth-part (index) (cdr (nth index *inspectee-parts*))) (defslimefun inspect-nth-part (index) (with-buffer-syntax () - (inspect-object (nth-part index)))) + (inspect-object (inspector-nth-part index)))) (defslimefun inspector-pop () "Drop the inspector stack and inspect the second element. Return Index: slime/slime.el diff -u slime/slime.el:1.343 slime/slime.el:1.344 --- slime/slime.el:1.343 Mon Jun 28 14:05:16 2004 +++ slime/slime.el Tue Jun 29 01:12:44 2004 @@ -6197,6 +6197,11 @@ 'slime-open-inspector) (push (point) slime-inspector-mark-stack)) +(defun slime-inspector-copy-down (number) + (interactive (list (slime-inspector-object-at-point))) + (slime-repl-send-string (format "%s" `(swank:inspector-nth-part ,number))) + (slime-repl)) + (defun slime-inspector-pop () (interactive) (slime-eval-async @@ -6229,6 +6234,7 @@ (slime-define-keys slime-inspector-mode-map ([return] 'slime-inspector-inspect-object-at-point) + ([(meta return)] 'slime-inspector-copy-down) ("\C-m" 'slime-inspector-inspect-object-at-point) ("l" 'slime-inspector-pop) ("n" 'slime-inspector-next) Index: slime/ChangeLog diff -u slime/ChangeLog:1.436 slime/ChangeLog:1.437 --- slime/ChangeLog:1.436 Mon Jun 28 14:05:28 2004 +++ slime/ChangeLog Tue Jun 29 01:12:44 2004 @@ -1,3 +1,9 @@ +2004-06-28 Thomas F. Burdick + * swank.lisp (inspector-nth-part): + * slime.el (slime-inspector-copy-down, slime-inspector-mode-map): + Added copy-down command (M-RET) to easily move an object from the + inspector to the repl. + 2004-06-28 Luke Gorrie * slime.el (slime-doc-map): New keymap for documentation @@ -212,6 +218,7 @@ * swank.lisp (prefixed-var): Intern *REAL-STANDARD-INPUT* etc in the SWANK package instead of the COMMON-LISP package. +>>>>>>> 1.436 2004-06-21 Luke Gorrie From lgorrie at common-lisp.net Tue Jun 29 10:48:12 2004 From: lgorrie at common-lisp.net (Luke Gorrie) Date: Tue, 29 Jun 2004 03:48:12 -0700 Subject: [slime-cvs] CVS update: slime/ChangeLog Message-ID: Update of /project/slime/cvsroot/slime In directory common-lisp.net:/tmp/cvs-serv26848 Modified Files: ChangeLog Log Message: *** empty log message *** Date: Tue Jun 29 03:48:11 2004 Author: lgorrie Index: slime/ChangeLog diff -u slime/ChangeLog:1.437 slime/ChangeLog:1.438 --- slime/ChangeLog:1.437 Tue Jun 29 01:12:44 2004 +++ slime/ChangeLog Tue Jun 29 03:48:11 2004 @@ -1,9 +1,10 @@ 2004-06-28 Thomas F. Burdick + * swank.lisp (inspector-nth-part): * slime.el (slime-inspector-copy-down, slime-inspector-mode-map): Added copy-down command (M-RET) to easily move an object from the inspector to the repl. - + 2004-06-28 Luke Gorrie * slime.el (slime-doc-map): New keymap for documentation From lgorrie at common-lisp.net Tue Jun 29 10:53:12 2004 From: lgorrie at common-lisp.net (Luke Gorrie) Date: Tue, 29 Jun 2004 03:53:12 -0700 Subject: [slime-cvs] CVS update: slime/ChangeLog Message-ID: Update of /project/slime/cvsroot/slime In directory common-lisp.net:/tmp/cvs-serv10957 Modified Files: ChangeLog Log Message: *** empty log message *** Date: Tue Jun 29 03:53:12 2004 Author: lgorrie Index: slime/ChangeLog diff -u slime/ChangeLog:1.438 slime/ChangeLog:1.439 --- slime/ChangeLog:1.438 Tue Jun 29 03:48:11 2004 +++ slime/ChangeLog Tue Jun 29 03:53:12 2004 @@ -219,7 +219,6 @@ * swank.lisp (prefixed-var): Intern *REAL-STANDARD-INPUT* etc in the SWANK package instead of the COMMON-LISP package. ->>>>>>> 1.436 2004-06-21 Luke Gorrie From lgorrie at common-lisp.net Tue Jun 29 17:39:01 2004 From: lgorrie at common-lisp.net (Luke Gorrie) Date: Tue, 29 Jun 2004 10:39:01 -0700 Subject: [slime-cvs] CVS update: slime/slime.el Message-ID: Update of /project/slime/cvsroot/slime In directory common-lisp.net:/tmp/cvs-serv11081 Modified Files: slime.el Log Message: (sldb-prune-initial-frames): Tweaked regexp for matching SWANK's own stack frames for effectiveness in SBCL. (slime-keys): Shadow remaining inf-lisp keys (C-c C-a, C-c C-v) with a null `slime-nop' command until we put them to a real use. Date: Tue Jun 29 10:39:01 2004 Author: lgorrie Index: slime/slime.el diff -u slime/slime.el:1.344 slime/slime.el:1.345 --- slime/slime.el:1.344 Tue Jun 29 01:12:44 2004 +++ slime/slime.el Tue Jun 29 10:39:01 2004 @@ -494,7 +494,15 @@ ("\I" slime-inspect :prefixed t :inferior t :sldb t) ("\C-]" slime-close-all-sexp :prefixed t :inferior t :sldb t) ("\C-xt" slime-list-threads :prefixed t :inferior t :sldb t) - ("\C-xc" slime-list-connections :prefixed t :inferior t :sldb t))) + ("\C-xc" slime-list-connections :prefixed t :inferior t :sldb t) + ;; Shadow unwanted bindings from inf-lisp + ("\C-a" slime-nop :prefixed t :inferior t :sldb t) + ("\C-v" slime-nop :prefixed t :inferior t :sldb t))) + +(defun slime-nop () + "The null command. Used to shadow currently-unused keybindings." + (interactive) + nil) (defvar slime-doc-map (make-sparse-keymap) "Keymap for documentation commands. Bound to a prefix key.") @@ -5544,7 +5552,7 @@ Regexp heuristics are used to avoid showing SWANK-internal frames." (or (loop for frame in frames for (number string) = frame - until (string-match "[^(]*(\\(SWANK\\|swank\\):" string) + until (string-match "^(+\\(SWANK\\|swank\\)\\>" string) collect frame) frames)) @@ -6198,6 +6206,7 @@ (push (point) slime-inspector-mark-stack)) (defun slime-inspector-copy-down (number) + "Evaluate the slot at point via the REPL (to set `*')." (interactive (list (slime-inspector-object-at-point))) (slime-repl-send-string (format "%s" `(swank:inspector-nth-part ,number))) (slime-repl)) From lgorrie at common-lisp.net Tue Jun 29 17:46:58 2004 From: lgorrie at common-lisp.net (Luke Gorrie) Date: Tue, 29 Jun 2004 10:46:58 -0700 Subject: [slime-cvs] CVS update: slime/swank.lisp Message-ID: Update of /project/slime/cvsroot/slime In directory common-lisp.net:/tmp/cvs-serv13293 Modified Files: swank.lisp Log Message: (open-streams): Renamed the restart around reads from the user-input stream from ABORT to ABORT-READ. Invoking this restart seems kinda dangerous, so better for 'a' in SLDB not to do so. Date: Tue Jun 29 10:46:58 2004 Author: lgorrie Index: slime/swank.lisp diff -u slime/swank.lisp:1.205 slime/swank.lisp:1.206 --- slime/swank.lisp:1.205 Tue Jun 29 01:12:44 2004 +++ slime/swank.lisp Tue Jun 29 10:46:58 2004 @@ -334,7 +334,8 @@ (let ((input-fn (lambda () (with-connection (connection) - (with-simple-restart (abort "Abort reading input from Emacs.") + (with-simple-restart (abort-read + "Abort reading input from Emacs.") (read-user-input-from-emacs)))))) (multiple-value-bind (in out) (make-fn-streams input-fn output-fn) (let ((out (or dedicated-output out))) From lgorrie at common-lisp.net Tue Jun 29 17:48:08 2004 From: lgorrie at common-lisp.net (Luke Gorrie) Date: Tue, 29 Jun 2004 10:48:08 -0700 Subject: [slime-cvs] CVS update: slime/ChangeLog Message-ID: Update of /project/slime/cvsroot/slime In directory common-lisp.net:/tmp/cvs-serv25345 Modified Files: ChangeLog Log Message: Date: Tue Jun 29 10:48:08 2004 Author: lgorrie Index: slime/ChangeLog diff -u slime/ChangeLog:1.439 slime/ChangeLog:1.440 --- slime/ChangeLog:1.439 Tue Jun 29 03:53:12 2004 +++ slime/ChangeLog Tue Jun 29 10:48:08 2004 @@ -1,3 +1,15 @@ +2004-06-29 Luke Gorrie + + * slime.el (sldb-prune-initial-frames): Tweaked regexp for + matching SWANK's own stack frames for effectiveness in SBCL. + (slime-keys): Shadow remaining inf-lisp keys (C-c C-a, C-c C-v) + with a null `slime-nop' command until we put them to a real use. + + * swank.lisp (open-streams): Renamed the restart around reads from + the user-input stream from ABORT to ABORT-READ. Invoking this + restart seems kinda dangerous, so better for 'a' in SLDB not to do + so. + 2004-06-28 Thomas F. Burdick * swank.lisp (inspector-nth-part): From lgorrie at common-lisp.net Tue Jun 29 20:17:05 2004 From: lgorrie at common-lisp.net (Luke Gorrie) Date: Tue, 29 Jun 2004 13:17:05 -0700 Subject: [slime-cvs] CVS update: slime/slime.el Message-ID: Update of /project/slime/cvsroot/slime In directory common-lisp.net:/tmp/cvs-serv26556 Modified Files: slime.el Log Message: >From Bill Clementson: (slime-who-map): Add extra bindings for the XREF commands as with the documentation commands. Now `C-c C-w C-c' is `slime-who-calls' in addition to `C-c C-w c', etc. Date: Tue Jun 29 13:17:05 2004 Author: lgorrie Index: slime/slime.el diff -u slime/slime.el:1.345 slime/slime.el:1.346 --- slime/slime.el:1.345 Tue Jun 29 10:39:01 2004 +++ slime/slime.el Tue Jun 29 13:17:05 2004 @@ -483,11 +483,6 @@ ("~" slime-sync-package-and-default-directory :prefixed t :inferior t) ("\M-p" slime-repl-set-package :prefixed t :inferior t) ;; Cross reference - ("\C-wc" slime-who-calls :prefixed t :inferior t :sldb t) - ("\C-wr" slime-who-references :prefixed t :inferior t :sldb t) - ("\C-wb" slime-who-binds :prefixed t :inferior t :sldb t) - ("\C-ws" slime-who-sets :prefixed t :inferior t :sldb t) - ("\C-wm" slime-who-macroexpands :prefixed t :inferior t :sldb t) ("<" slime-list-callers :prefixed t :inferior t :sldb t) (">" slime-list-callees :prefixed t :inferior t :sldb t) ;; "Other" @@ -516,6 +511,16 @@ (?h slime-hyperspec-lookup) (?~ common-lisp-hyperspec-format))) +(defvar slime-who-map (make-sparse-keymap) + "Keymap for who-xref commands. Bound to a prefix key.") + +(defvar slime-who-bindings + '((?c slime-who-calls) + (?r slime-who-references) + (?b slime-who-binds) + (?s slime-who-sets) + (?m slime-who-macroexpands))) + ;; Maybe a good idea, maybe not.. (defvar slime-prefix-key "\C-c" "The prefix key to use in SLIME keybinding sequences.") @@ -551,7 +556,17 @@ (let ((modified (slime-control-modified-char key))) (define-key slime-doc-map (string modified) command))))) ;; C-c C-d is the prefix for the doc map. - (slime-define-key "\C-d" slime-doc-map :prefixed t :inferior t)) + (slime-define-key "\C-d" slime-doc-map :prefixed t :inferior t) + ;; Who-xref + (setq slime-who-map (make-sparse-keymap)) + (loop for (key command) in slime-who-bindings + do (progn + ;; We bind both unmodified and with control. + (define-key slime-who-map (string key) command) + (let ((modified (slime-control-modified-char key))) + (define-key slime-who-map (string modified) command)))) + ;; C-c C-w is the prefix for the who-xref map. + (slime-define-key "\C-w" slime-who-map :prefixed t :inferior t)) (defun slime-control-modified-char (char) "Return the control-modified version of CHAR." @@ -2514,6 +2529,7 @@ ("\t" 'slime-indent-and-complete-symbol) (" " 'slime-space) ("\C-c\C-d" slime-doc-map) + ("\C-c\C-w" slime-who-map) ("\C-\M-x" 'slime-eval-defun) ("\C-c\C-o" 'slime-repl-clear-output) ("\C-c\C-t" 'slime-repl-clear-buffer) From lgorrie at common-lisp.net Tue Jun 29 20:17:13 2004 From: lgorrie at common-lisp.net (Luke Gorrie) Date: Tue, 29 Jun 2004 13:17:13 -0700 Subject: [slime-cvs] CVS update: slime/ChangeLog Message-ID: Update of /project/slime/cvsroot/slime In directory common-lisp.net:/tmp/cvs-serv27027 Modified Files: ChangeLog Log Message: Date: Tue Jun 29 13:17:13 2004 Author: lgorrie Index: slime/ChangeLog diff -u slime/ChangeLog:1.440 slime/ChangeLog:1.441 --- slime/ChangeLog:1.440 Tue Jun 29 10:48:08 2004 +++ slime/ChangeLog Tue Jun 29 13:17:13 2004 @@ -1,3 +1,9 @@ +2004-06-29 Bill Clementson + + * slime.el (slime-who-map): Add extra bindings for the XREF + commands as with the documentation commands. Now `C-c C-w C-c' is + `slime-who-calls' in addition to `C-c C-w c', etc. + 2004-06-29 Luke Gorrie * slime.el (sldb-prune-initial-frames): Tweaked regexp for From lgorrie at common-lisp.net Tue Jun 29 20:18:06 2004 From: lgorrie at common-lisp.net (Luke Gorrie) Date: Tue, 29 Jun 2004 13:18:06 -0700 Subject: [slime-cvs] CVS update: slime/mkdist.sh Message-ID: Update of /project/slime/cvsroot/slime In directory common-lisp.net:/tmp/cvs-serv31520 Added Files: mkdist.sh Log Message: New shell script for creating a tarball for distribution. Date: Tue Jun 29 13:18:05 2004 Author: lgorrie From lgorrie at common-lisp.net Tue Jun 29 20:18:46 2004 From: lgorrie at common-lisp.net (Luke Gorrie) Date: Tue, 29 Jun 2004 13:18:46 -0700 Subject: [slime-cvs] CVS update: slime/ChangeLog Message-ID: Update of /project/slime/cvsroot/slime In directory common-lisp.net:/tmp/cvs-serv1767 Modified Files: ChangeLog Log Message: Date: Tue Jun 29 13:18:45 2004 Author: lgorrie Index: slime/ChangeLog diff -u slime/ChangeLog:1.441 slime/ChangeLog:1.442 --- slime/ChangeLog:1.441 Tue Jun 29 13:17:13 2004 +++ slime/ChangeLog Tue Jun 29 13:18:45 2004 @@ -1,3 +1,8 @@ +2004-06-29 Luke Gorrie + + * mkdist.sh: New shell script for creating a tarball for + distribution. + 2004-06-29 Bill Clementson * slime.el (slime-who-map): Add extra bindings for the XREF From lgorrie at common-lisp.net Tue Jun 29 22:06:51 2004 From: lgorrie at common-lisp.net (Luke Gorrie) Date: Tue, 29 Jun 2004 15:06:51 -0700 Subject: [slime-cvs] CVS update: slime/NEWS Message-ID: Update of /project/slime/cvsroot/slime In directory common-lisp.net:/tmp/cvs-serv21560 Modified Files: NEWS Log Message: Added preliminary release notes for alpha-1. Date: Tue Jun 29 15:06:51 2004 Author: lgorrie Index: slime/NEWS diff -u slime/NEWS:1.1 slime/NEWS:1.2 --- slime/NEWS:1.1 Wed Apr 28 09:46:26 2004 +++ slime/NEWS Tue Jun 29 15:06:51 2004 @@ -1,11 +1,76 @@ * SLIME News -*- outline -*- -This file records changes to SLIME that are interesting for users to -read about. It is much higher-level than the ChangeLog. +* 1.0 alpha-1 (June 2004) -* 0.13 (work in progress) +This preview release of SLIME is a precursor for an upcoming 1.0 +release. We're planning to use our "alpha period" to introduce SLIME +to more users, flush out bugs, and hear some final feedback that we +can consider for the 1.0 release. -** The *slime-events* buffer now uses outline-minor-mode. -This buffer records all the protocol messages sent between Emacs and -Lisp. +We're tentatively planning for our alpha period to last until around +the end of July, then to be followed by a beta period until late +August when we make the finished 1.0 release. We're only interested in +adding or changing features during the alpha period, so if you want to +change something please try to get your patch applied before the end +of July. + +** Supported Lisp implementations + +Below is a list of the Lisp implementations that we support and their +associated caveats. + +Note that some Lisp systems have received more development attention +because they're popular with the currently active SLIME developers, +while others have only smaller user communities so far. The support +for a particular Lisp is primarily written and improved by its own +users, and it's good for your karma to improve the backend for your +favourite Lisp implementation. + +*** CMU Common Lisp + +We support CMUCL version 18e and higher. The overall support is very +mature. + +The cross-reference commands are based on the CMUCL XREF +package. You'll need to setup XREF information recording to use those +commands, and in current CMUCLs this is slightly awkward. + +*** Steel Bank Common Lisp + +We support SBCL version 0.8.12 and higher. The support is very mature. + +An "SBCL exclusive" feature is reference-conditions. Some SBCL +conditions include a slot of documentation references (e.g. to the +Hyperspec and SBCL manual) and the SLIME debugger is able to format +these as hyperlinks. + +For the (v)iew-source command in the debugger to find the exact source +expression corresponding to a stack frame, the code must have been +compiled with at least (optimize (debug 2)). Otherwise the results +will only have top-level-form precision. + +The XREF commands are not available. + +*** OpenMCL + +We support OpenMCL 0.14.2p1, however our debugger can't invoke +restarts in this version due to a bug in +INVOKE-RESTART-INTERACTIVELY. This bug has been fixed in OpenMCL's CVS +repository and we recommend upgrading to either the CVS copy or a +later release if available. + +The OpenMCL support is quite mature. + +The XREF commands are not available. + +*** LispWorks + +We support LispWorks version 4.3 and higher. The support is quite +mature. + +*** Allegro CL + +*** CLISP + +*** Armed Bear Common Lisp From lgorrie at common-lisp.net Tue Jun 29 22:07:00 2004 From: lgorrie at common-lisp.net (Luke Gorrie) Date: Tue, 29 Jun 2004 15:07:00 -0700 Subject: [slime-cvs] CVS update: slime/ChangeLog Message-ID: Update of /project/slime/cvsroot/slime In directory common-lisp.net:/tmp/cvs-serv22271 Modified Files: ChangeLog Log Message: Date: Tue Jun 29 15:07:00 2004 Author: lgorrie Index: slime/ChangeLog diff -u slime/ChangeLog:1.442 slime/ChangeLog:1.443 --- slime/ChangeLog:1.442 Tue Jun 29 13:18:45 2004 +++ slime/ChangeLog Tue Jun 29 15:07:00 2004 @@ -1,3 +1,7 @@ +2004-06-30 Luke Gorrie + + * NEWS: Wrote preliminary release notes for alpha-1. + 2004-06-29 Luke Gorrie * mkdist.sh: New shell script for creating a tarball for From lgorrie at common-lisp.net Tue Jun 29 22:12:53 2004 From: lgorrie at common-lisp.net (Luke Gorrie) Date: Tue, 29 Jun 2004 15:12:53 -0700 Subject: [slime-cvs] CVS update: slime/mkdist.sh Message-ID: Update of /project/slime/cvsroot/slime In directory common-lisp.net:/tmp/cvs-serv14242 Modified Files: mkdist.sh Log Message: Added NEWS file. Date: Tue Jun 29 15:12:53 2004 Author: lgorrie Index: slime/mkdist.sh diff -u slime/mkdist.sh:1.1 slime/mkdist.sh:1.2 --- slime/mkdist.sh:1.1 Tue Jun 29 13:18:05 2004 +++ slime/mkdist.sh Tue Jun 29 15:12:53 2004 @@ -5,7 +5,7 @@ if [ -d $dist ]; then rm -rf $dist; fi mkdir $dist -cp README HACKING ChangeLog *.el *.lisp $dist/ +cp NEWS README HACKING ChangeLog *.el *.lisp $dist/ mkdir $dist/doc cp doc/Makefile doc/slime.texi doc/texinfo-tabulate.awk $dist/doc From heller at common-lisp.net Wed Jun 30 06:59:04 2004 From: heller at common-lisp.net (Helmut Eller) Date: Tue, 29 Jun 2004 23:59:04 -0700 Subject: [slime-cvs] CVS update: slime/NEWS Message-ID: Update of /project/slime/cvsroot/slime In directory common-lisp.net:/tmp/cvs-serv11002 Modified Files: NEWS Log Message: *** empty log message *** Date: Tue Jun 29 23:59:04 2004 Author: heller Index: slime/NEWS diff -u slime/NEWS:1.2 slime/NEWS:1.3 --- slime/NEWS:1.2 Tue Jun 29 15:06:51 2004 +++ slime/NEWS Tue Jun 29 23:59:04 2004 @@ -35,6 +35,15 @@ package. You'll need to setup XREF information recording to use those commands, and in current CMUCLs this is slightly awkward. +The :sigio communication style conflicts with certain C libraries, +e.g. libSDL. You'll need to switch to :fd-handler in this case. +:sigio may also not work well on Solaris. + +On FreeBSD or Irix may get errors like "NIL is not of type HOST-ENTRY" +or "Error binding socket to port 0: Cannot assign requested address". +The only known workaround at the moment is to remove the :host +argument in CREATE-SOCKET in swank-cmucl.lisp. + *** Steel Bank Common Lisp We support SBCL version 0.8.12 and higher. The support is very mature. @@ -65,12 +74,24 @@ *** LispWorks -We support LispWorks version 4.3 and higher. The support is quite +We support LispWorks version 4.1 and higher. The support is quite mature. +On OS X you'll have to remove the :address argument in CREATE-SOCKET +in swank-lispworks.lisp. This is a LispWorks bug. + *** Allegro CL *** CLISP + +We support CLISP version 2.32 or newer. You'll need a version with +socket support; this may require to start CLISP with "clisp -K full". + +The backtrace for compiled functions is not very informative. +Interpreted code is usually easer to debug. + +M-. (find-definition) only works if the fasl file is in the same +directory as the source file. *** Armed Bear Common Lisp From mbaringer at common-lisp.net Wed Jun 30 07:24:21 2004 From: mbaringer at common-lisp.net (Marco Baringer) Date: Wed, 30 Jun 2004 00:24:21 -0700 Subject: [slime-cvs] CVS update: slime/slime.el slime/ChangeLog Message-ID: Update of /project/slime/cvsroot/slime In directory common-lisp.net:/tmp/cvs-serv4525 Modified Files: slime.el ChangeLog Log Message: 2004-06-29 Thomas Burdick * slime.el: Indicate when the REPL is in the debugger's context (slime-debug-level): new connection var (slime-dispatch-event): set slime-debug-level to match *sldb-level* (slime-repl-insert-prompt): show debug-level in prompt when > 0 Date: Wed Jun 30 00:24:20 2004 Author: mbaringer Index: slime/slime.el diff -u slime/slime.el:1.346 slime/slime.el:1.347 --- slime/slime.el:1.346 Tue Jun 29 13:17:05 2004 +++ slime/slime.el Wed Jun 30 00:24:20 2004 @@ -1256,6 +1256,9 @@ (string-match "^[^ ]*" name) (capitalize (match-string 0 name)))) +(slime-def-connection-var slime-debug-level 0 + "The current level of recursive debugging.") + (defvar slime-words-of-encouragement `("Let the hacking commence!" @@ -1602,9 +1605,11 @@ (sldb-activate thread level)) ((:debug thread level condition restarts frames) (assert thread) + (setf (slime-debug-level) level) (sldb-setup thread level condition restarts frames)) ((:debug-return thread level) (assert thread) + (setf (slime-debug-level) (1- level)) (sldb-exit thread level)) ((:emacs-interrupt thread) (cond ((slime-use-sigint-for-interrupt) (slime-send-sigint)) @@ -2168,7 +2173,9 @@ (slime-insert-propertized '(face slime-repl-result-face) result) (unless (bolp) (insert "\n")) (let ((prompt-start (point)) - (prompt (format "%s> " (slime-lisp-package)))) + (prompt (if (> (slime-debug-level) 0) + (format "%s [%d]> " (slime-lisp-package) (slime-debug-level)) + (format "%s> " (slime-lisp-package))))) (slime-propertize-region '(face slime-repl-prompt-face read-only t Index: slime/ChangeLog diff -u slime/ChangeLog:1.443 slime/ChangeLog:1.444 --- slime/ChangeLog:1.443 Tue Jun 29 15:07:00 2004 +++ slime/ChangeLog Wed Jun 30 00:24:20 2004 @@ -1,3 +1,10 @@ +2004-06-29 Thomas Burdick + + * slime.el: Indicate when the REPL is in the debugger's context + (slime-debug-level): new connection var + (slime-dispatch-event): set slime-debug-level to match *sldb-level* + (slime-repl-insert-prompt): show debug-level in prompt when > 0 + 2004-06-30 Luke Gorrie * NEWS: Wrote preliminary release notes for alpha-1. From lgorrie at common-lisp.net Wed Jun 30 13:26:21 2004 From: lgorrie at common-lisp.net (Luke Gorrie) Date: Wed, 30 Jun 2004 06:26:21 -0700 Subject: [slime-cvs] CVS update: slime/slime.el Message-ID: Update of /project/slime/cvsroot/slime In directory common-lisp.net:/tmp/cvs-serv21537 Modified Files: slime.el Log Message: Backed out the previous change (below). Has bugs and needs more thinking. Date: Wed Jun 30 06:26:21 2004 Author: lgorrie Index: slime/slime.el diff -u slime/slime.el:1.347 slime/slime.el:1.348 --- slime/slime.el:1.347 Wed Jun 30 00:24:20 2004 +++ slime/slime.el Wed Jun 30 06:26:21 2004 @@ -1256,9 +1256,6 @@ (string-match "^[^ ]*" name) (capitalize (match-string 0 name)))) -(slime-def-connection-var slime-debug-level 0 - "The current level of recursive debugging.") - (defvar slime-words-of-encouragement `("Let the hacking commence!" @@ -1605,11 +1602,9 @@ (sldb-activate thread level)) ((:debug thread level condition restarts frames) (assert thread) - (setf (slime-debug-level) level) (sldb-setup thread level condition restarts frames)) ((:debug-return thread level) (assert thread) - (setf (slime-debug-level) (1- level)) (sldb-exit thread level)) ((:emacs-interrupt thread) (cond ((slime-use-sigint-for-interrupt) (slime-send-sigint)) @@ -2173,9 +2168,7 @@ (slime-insert-propertized '(face slime-repl-result-face) result) (unless (bolp) (insert "\n")) (let ((prompt-start (point)) - (prompt (if (> (slime-debug-level) 0) - (format "%s [%d]> " (slime-lisp-package) (slime-debug-level)) - (format "%s> " (slime-lisp-package))))) + (prompt (format "%s> " (slime-lisp-package)))) (slime-propertize-region '(face slime-repl-prompt-face read-only t From lgorrie at common-lisp.net Wed Jun 30 13:37:57 2004 From: lgorrie at common-lisp.net (Luke Gorrie) Date: Wed, 30 Jun 2004 06:37:57 -0700 Subject: [slime-cvs] CVS update: slime/ChangeLog Message-ID: Update of /project/slime/cvsroot/slime In directory common-lisp.net:/tmp/cvs-serv6432 Modified Files: ChangeLog Log Message: Date: Wed Jun 30 06:37:57 2004 Author: lgorrie Index: slime/ChangeLog diff -u slime/ChangeLog:1.444 slime/ChangeLog:1.445 --- slime/ChangeLog:1.444 Wed Jun 30 00:24:20 2004 +++ slime/ChangeLog Wed Jun 30 06:37:57 2004 @@ -1,3 +1,8 @@ +2004-06-30 Luke Gorrie + + * slime.el: Backed out the previous change (below). Has bugs and + needs more thinking. + 2004-06-29 Thomas Burdick * slime.el: Indicate when the REPL is in the debugger's context From lgorrie at common-lisp.net Wed Jun 30 13:45:32 2004 From: lgorrie at common-lisp.net (Luke Gorrie) Date: Wed, 30 Jun 2004 06:45:32 -0700 Subject: [slime-cvs] CVS update: slime/swank-sbcl.lisp Message-ID: Update of /project/slime/cvsroot/slime In directory common-lisp.net:/tmp/cvs-serv17172 Modified Files: swank-sbcl.lisp Log Message: (preferred-communication-style): Choose :fd-handler instead of :sigio when threads aren't available. A lot of people seem to have had problems with :sigio on SBCL. Date: Wed Jun 30 06:45:32 2004 Author: lgorrie Index: slime/swank-sbcl.lisp diff -u slime/swank-sbcl.lisp:1.93 slime/swank-sbcl.lisp:1.94 --- slime/swank-sbcl.lisp:1.93 Sun Jun 27 08:00:56 2004 +++ slime/swank-sbcl.lisp Wed Jun 30 06:45:32 2004 @@ -38,13 +38,10 @@ ;;; TCP Server (defimplementation preferred-communication-style () - (cond ((and (sb-int:featurep :sb-thread) - (sb-int:featurep :sb-futex)) - :spawn) - ((fboundp 'sb-posix::fcntl) - :sigio) - (t - :fd-handler))) + (if (and (sb-int:featurep :sb-thread) + (sb-int:featurep :sb-futex)) + :spawn + :fd-handler)) (defun resolve-hostname (name) (car (sb-bsd-sockets:host-ent-addresses From lgorrie at common-lisp.net Wed Jun 30 13:46:02 2004 From: lgorrie at common-lisp.net (Luke Gorrie) Date: Wed, 30 Jun 2004 06:46:02 -0700 Subject: [slime-cvs] CVS update: slime/ChangeLog Message-ID: Update of /project/slime/cvsroot/slime In directory common-lisp.net:/tmp/cvs-serv18284 Modified Files: ChangeLog Log Message: Date: Wed Jun 30 06:46:02 2004 Author: lgorrie Index: slime/ChangeLog diff -u slime/ChangeLog:1.445 slime/ChangeLog:1.446 --- slime/ChangeLog:1.445 Wed Jun 30 06:37:57 2004 +++ slime/ChangeLog Wed Jun 30 06:46:02 2004 @@ -1,5 +1,9 @@ 2004-06-30 Luke Gorrie + * swank-sbcl.lisp (preferred-communication-style): Choose + :fd-handler instead of :sigio when threads aren't available. A lot + of people seem to have had problems with :sigio on SBCL. + * slime.el: Backed out the previous change (below). Has bugs and needs more thinking. From fayletcherrgalljef at financemail.net Wed Jun 30 12:42:55 2004 From: fayletcherrgalljef at financemail.net (emile semonick) Date: Wed, 30 Jun 2004 23:42:55 +1100 Subject: [slime-cvs] Gliw Prescriptions Written And Filled On1ine! Message-ID: <62B247DB.18B628D@financemail.net> ccpym anaptomorphus guobiao Get The Most Popular Meedications Now! X at n`ax --V at 1ium-- right to your door. We make it easier and faster than ever to get the prescriptions you need .. K W http://bl.ri.sukiyaki3276tabs.us/f74/ Four surgeons were taking a coffee break and were discussing their work.The first said, "I think accountants are the easiest to operate on. You open them up and everything inside is numbered." The second said, "I think librarians are the easiest to operate on. You open them up and everything inside is in alphabetical order." The third said, "I like to operate on electricians. You open them up and everything inside is color-coded." The fourth one said, "I like to operate on lawyers. They're heartless spineless, gutless, and their heads and their ass are interchangeable." A young man was walking through a super market to pick up a few things when he noticed an old lady following him. ??Pardon me," she said. "I'm sorry if my staring at you has made you feel uncomfortable. It's just that you look just like my son, who died recently.?? I??m very sorry," replied the young man, "is there anything I can do for you??? Yes," she said, "as I'm leaving, would you say?? Goodbye, mother?' It would make me feel so much better.?? Sure," answered the young man. As the old woman was leaving, he called out,?? Goodbye, Mother!" Then, as he stepped up to the checkout counter, he saw that his total was $127.00. "How can that be?" he asked. "I only purchased a few things!?? The clerk replied, "Your mother said you'd pay for her." taimator0meiyokei68tagawash,ooba nanukama. From myaujnfhaarzv at megacity.com Wed Jun 30 14:54:12 2004 From: myaujnfhaarzv at megacity.com (Odessa Dejesus) Date: Wed, 30 Jun 2004 09:54:12 -0500 Subject: [slime-cvs] Fwd: Get All Meds. Any Meds You Want Prescriptions Written and Filled Online. Message-ID: An HTML attachment was scrubbed... URL: From lgorrie at common-lisp.net Wed Jun 30 14:10:29 2004 From: lgorrie at common-lisp.net (Luke Gorrie) Date: Wed, 30 Jun 2004 07:10:29 -0700 Subject: [slime-cvs] CVS update: slime/doc/Makefile Message-ID: Update of /project/slime/cvsroot/slime/doc In directory common-lisp.net:/tmp/cvs-serv21466 Modified Files: Makefile Log Message: *** empty log message *** Date: Wed Jun 30 07:10:29 2004 Author: lgorrie Index: slime/doc/Makefile diff -u slime/doc/Makefile:1.4 slime/doc/Makefile:1.5 --- slime/doc/Makefile:1.4 Tue Jun 22 07:06:56 2004 +++ slime/doc/Makefile Wed Jun 30 07:10:29 2004 @@ -43,7 +43,7 @@ contributors.texi: ../ChangeLog Makefile texinfo-tabulate.awk cat ../ChangeLog | \ sed -ne '/^[0-9]/{s/^[^ ]* *//; s/ *<.*//; p;}' | \ - sort -d | \ + sort | \ uniq -c | \ sort -nr| \ sed -e 's/^[^A-Z]*//' | \ From MFJEBJTHZGLTB at socal.rr.com Wed Jun 30 14:57:42 2004 From: MFJEBJTHZGLTB at socal.rr.com (Jarrod Root) Date: Wed, 30 Jun 2004 20:57:42 +0600 Subject: [slime-cvs] Ask the pha.rmacist Message-ID: <7512RND_LC_CHAR[1-5]636unbs$0880658d9$0w3e81@%RND_NAME> Try this one Slime-cvs GetAnyMedication UNeed http://www.sundance4111pills.biz/c49 WishNot-ToRecieve http://www.sundance4111pills.biz/0.ddd When aiken is at alps the scrapbook will be autoclave tenet and crowbaitadsorb so inhere is the dutch and mumford.Juliet From lgorrie at common-lisp.net Wed Jun 30 16:40:02 2004 From: lgorrie at common-lisp.net (Luke Gorrie) Date: Wed, 30 Jun 2004 09:40:02 -0700 Subject: [slime-cvs] CVS update: slime/ChangeLog Message-ID: Update of /project/slime/cvsroot/slime In directory common-lisp.net:/tmp/cvs-serv5696 Modified Files: ChangeLog Log Message: *** empty log message *** Date: Wed Jun 30 09:40:02 2004 Author: lgorrie Index: slime/ChangeLog diff -u slime/ChangeLog:1.446 slime/ChangeLog:1.447 --- slime/ChangeLog:1.446 Wed Jun 30 06:46:02 2004 +++ slime/ChangeLog Wed Jun 30 09:40:01 2004 @@ -4,16 +4,6 @@ :fd-handler instead of :sigio when threads aren't available. A lot of people seem to have had problems with :sigio on SBCL. - * slime.el: Backed out the previous change (below). Has bugs and - needs more thinking. - -2004-06-29 Thomas Burdick - - * slime.el: Indicate when the REPL is in the debugger's context - (slime-debug-level): new connection var - (slime-dispatch-event): set slime-debug-level to match *sldb-level* - (slime-repl-insert-prompt): show debug-level in prompt when > 0 - 2004-06-30 Luke Gorrie * NEWS: Wrote preliminary release notes for alpha-1. From ozowj at martindale.com Wed Jun 30 19:52:24 2004 From: ozowj at martindale.com (Kari ) Date: Wed, 30 Jun 2004 20:52:24 +0100 Subject: [slime-cvs] pay less for Office 2000 Premium Edition PE juncture Message-ID: <304551622230.58904@ozowj@martindale.com> An HTML attachment was scrubbed... URL: From lgorrie at common-lisp.net Wed Jun 30 18:54:37 2004 From: lgorrie at common-lisp.net (Luke Gorrie) Date: Wed, 30 Jun 2004 11:54:37 -0700 Subject: [slime-cvs] CVS update: slime/slime.el Message-ID: Update of /project/slime/cvsroot/slime In directory common-lisp.net:/tmp/cvs-serv25021 Modified Files: slime.el Log Message: (slime-read-port-and-connect-to-running-swank) (slime-connect, slime-open-stream-to-lisp): Replace "localhost" with "127.0.0.1". This is believed to avoid unwanted DNS lookups on certain operating systems. The lookups can become crippling if the DNS server isn't available. Date: Wed Jun 30 11:54:37 2004 Author: lgorrie Index: slime/slime.el diff -u slime/slime.el:1.348 slime/slime.el:1.349 --- slime/slime.el:1.348 Wed Jun 30 06:26:21 2004 +++ slime/slime.el Wed Jun 30 11:54:37 2004 @@ -1212,7 +1212,7 @@ (cond ((file-exists-p (slime-swank-port-file)) (let ((port (slime-read-swank-port))) (delete-file (slime-swank-port-file)) - (slime-connect "localhost" port))) + (slime-connect "127.0.0.1" port))) ((and retries (zerop retries)) (message "Failed to connect to Swank.")) (t @@ -1223,7 +1223,7 @@ (defun slime-connect (host port &optional kill-old-p) "Connect to a running Swank server" - (interactive (list (read-from-minibuffer "Host: " "localhost") + (interactive (list (read-from-minibuffer "Host: " "127.0.0.1") (read-from-minibuffer "Port: " "4005" nil t) (if (null slime-net-processes) t @@ -2001,7 +2001,7 @@ (let ((stream (open-network-stream "*lisp-output-stream*" (slime-with-connection-buffer () (current-buffer)) - "localhost" port))) + "127.0.0.1" port))) (when slime-kill-without-query-p (process-kill-without-query stream)) (set-process-filter stream 'slime-output-filter) @@ -2168,7 +2168,13 @@ (slime-insert-propertized '(face slime-repl-result-face) result) (unless (bolp) (insert "\n")) (let ((prompt-start (point)) - (prompt (format "%s> " (slime-lisp-package)))) + (prompt (if (sldb-find-buffer) + ;; Debugger is active: add debug level to prompt + (format "%s[%S]> " + (slime-lisp-package) + (with-current-buffer (sldb-find-buffer) + sldb-level)) + (format "%s> " (slime-lisp-package))))) (slime-propertize-region '(face slime-repl-prompt-face read-only t @@ -2333,19 +2339,22 @@ balanced." (interactive) (slime-check-connected) - (assert (<= (point) slime-repl-input-end-mark)) - (cond ((get-text-property (point) 'slime-repl-old-input) - (slime-repl-grab-old-input)) - (current-prefix-arg - (slime-repl-send-input)) - (slime-repl-read-mode ; bad style? - (slime-repl-send-input t)) - ((slime-input-complete-p slime-repl-input-start-mark - slime-repl-input-end-mark) - (slime-repl-send-input t)) - (t - (slime-repl-newline-and-indent) - (message "[input not complete]")))) + ;; If the REPL is in the debugger then pop up SLDB instead. + (if (sldb-find-buffer slime-current-thread) + (pop-to-buffer (sldb-find-buffer slime-current-thread)) + (assert (<= (point) slime-repl-input-end-mark)) + (cond ((get-text-property (point) 'slime-repl-old-input) + (slime-repl-grab-old-input)) + (current-prefix-arg + (slime-repl-send-input)) + (slime-repl-read-mode ; bad style? + (slime-repl-send-input t)) + ((slime-input-complete-p slime-repl-input-start-mark + slime-repl-input-end-mark) + (slime-repl-send-input t)) + (t + (slime-repl-newline-and-indent) + (message "[input not complete]"))))) (defun slime-repl-send-input (&optional newline) "Goto to the end of the input and send the current input. @@ -5407,8 +5416,8 @@ (defvar sldb-buffers '() "List of sldb-buffers.") -(defun sldb-find-buffer (thread) - (cdr (assoc* (cons (slime-connection) thread) +(defun sldb-find-buffer (&optional thread) + (cdr (assoc* (cons (slime-connection) (or thread slime-current-thread) ) sldb-buffers :test #'equal))) @@ -7404,13 +7413,12 @@ (slime-defun-if-undefined line-beginning-position (&optional n) (save-excursion - (forward-line n) + (beginning-of-line n) (point))) (slime-defun-if-undefined line-end-position (&optional n) (save-excursion - (forward-line n) - (end-of-line) + (end-of-line n) (point))) (slime-defun-if-undefined check-parens () From lgorrie at common-lisp.net Wed Jun 30 18:57:38 2004 From: lgorrie at common-lisp.net (Luke Gorrie) Date: Wed, 30 Jun 2004 11:57:38 -0700 Subject: [slime-cvs] CVS update: slime/ChangeLog Message-ID: Update of /project/slime/cvsroot/slime In directory common-lisp.net:/tmp/cvs-serv15698 Modified Files: ChangeLog Log Message: Date: Wed Jun 30 11:57:38 2004 Author: lgorrie Index: slime/ChangeLog diff -u slime/ChangeLog:1.447 slime/ChangeLog:1.448 --- slime/ChangeLog:1.447 Wed Jun 30 09:40:01 2004 +++ slime/ChangeLog Wed Jun 30 11:57:37 2004 @@ -1,5 +1,11 @@ 2004-06-30 Luke Gorrie + * slime.el (slime-read-port-and-connect-to-running-swank) + (slime-connect, slime-open-stream-to-lisp): Replace "localhost" + with "127.0.0.1". This is believed to avoid unwanted DNS lookups + on certain operating systems. The lookups can become crippling if + the DNS server isn't available. + * swank-sbcl.lisp (preferred-communication-style): Choose :fd-handler instead of :sigio when threads aren't available. A lot of people seem to have had problems with :sigio on SBCL. From lgorrie at common-lisp.net Wed Jun 30 18:59:46 2004 From: lgorrie at common-lisp.net (Luke Gorrie) Date: Wed, 30 Jun 2004 11:59:46 -0700 Subject: [slime-cvs] CVS update: slime/slime.el Message-ID: Update of /project/slime/cvsroot/slime In directory common-lisp.net:/tmp/cvs-serv2095 Modified Files: slime.el Log Message: Rolled back some things that I committed by accident. Date: Wed Jun 30 11:59:45 2004 Author: lgorrie Index: slime/slime.el diff -u slime/slime.el:1.349 slime/slime.el:1.350 --- slime/slime.el:1.349 Wed Jun 30 11:54:37 2004 +++ slime/slime.el Wed Jun 30 11:59:45 2004 @@ -2168,13 +2168,7 @@ (slime-insert-propertized '(face slime-repl-result-face) result) (unless (bolp) (insert "\n")) (let ((prompt-start (point)) - (prompt (if (sldb-find-buffer) - ;; Debugger is active: add debug level to prompt - (format "%s[%S]> " - (slime-lisp-package) - (with-current-buffer (sldb-find-buffer) - sldb-level)) - (format "%s> " (slime-lisp-package))))) + (prompt (format "%s> " (slime-lisp-package)))) (slime-propertize-region '(face slime-repl-prompt-face read-only t @@ -2339,22 +2333,19 @@ balanced." (interactive) (slime-check-connected) - ;; If the REPL is in the debugger then pop up SLDB instead. - (if (sldb-find-buffer slime-current-thread) - (pop-to-buffer (sldb-find-buffer slime-current-thread)) - (assert (<= (point) slime-repl-input-end-mark)) - (cond ((get-text-property (point) 'slime-repl-old-input) - (slime-repl-grab-old-input)) - (current-prefix-arg - (slime-repl-send-input)) - (slime-repl-read-mode ; bad style? - (slime-repl-send-input t)) - ((slime-input-complete-p slime-repl-input-start-mark - slime-repl-input-end-mark) - (slime-repl-send-input t)) - (t - (slime-repl-newline-and-indent) - (message "[input not complete]"))))) + (assert (<= (point) slime-repl-input-end-mark)) + (cond ((get-text-property (point) 'slime-repl-old-input) + (slime-repl-grab-old-input)) + (current-prefix-arg + (slime-repl-send-input)) + (slime-repl-read-mode ; bad style? + (slime-repl-send-input t)) + ((slime-input-complete-p slime-repl-input-start-mark + slime-repl-input-end-mark) + (slime-repl-send-input t)) + (t + (slime-repl-newline-and-indent) + (message "[input not complete]")))) (defun slime-repl-send-input (&optional newline) "Goto to the end of the input and send the current input. @@ -5416,8 +5407,8 @@ (defvar sldb-buffers '() "List of sldb-buffers.") -(defun sldb-find-buffer (&optional thread) - (cdr (assoc* (cons (slime-connection) (or thread slime-current-thread) ) +(defun sldb-find-buffer (thread) + (cdr (assoc* (cons (slime-connection) thread) sldb-buffers :test #'equal))) @@ -7413,12 +7404,13 @@ (slime-defun-if-undefined line-beginning-position (&optional n) (save-excursion - (beginning-of-line n) + (forward-line n) (point))) (slime-defun-if-undefined line-end-position (&optional n) (save-excursion - (end-of-line n) + (forward-line n) + (end-of-line) (point))) (slime-defun-if-undefined check-parens () From lgorrie at common-lisp.net Wed Jun 30 20:55:33 2004 From: lgorrie at common-lisp.net (Luke Gorrie) Date: Wed, 30 Jun 2004 13:55:33 -0700 Subject: [slime-cvs] CVS update: slime/slime.el Message-ID: Update of /project/slime/cvsroot/slime In directory common-lisp.net:/tmp/cvs-serv7904 Modified Files: slime.el Log Message: (line-beginning-position, line-end-position): Simple bugfix suggested by Richard Klinda. Date: Wed Jun 30 13:55:33 2004 Author: lgorrie Index: slime/slime.el diff -u slime/slime.el:1.350 slime/slime.el:1.351 --- slime/slime.el:1.350 Wed Jun 30 11:59:45 2004 +++ slime/slime.el Wed Jun 30 13:55:33 2004 @@ -7404,13 +7404,12 @@ (slime-defun-if-undefined line-beginning-position (&optional n) (save-excursion - (forward-line n) + (beginning-of-line n) (point))) (slime-defun-if-undefined line-end-position (&optional n) (save-excursion - (forward-line n) - (end-of-line) + (end-of-line n) (point))) (slime-defun-if-undefined check-parens () From heller at common-lisp.net Wed Jun 30 21:06:38 2004 From: heller at common-lisp.net (Helmut Eller) Date: Wed, 30 Jun 2004 14:06:38 -0700 Subject: [slime-cvs] CVS update: slime/swank.lisp Message-ID: Update of /project/slime/cvsroot/slime In directory common-lisp.net:/tmp/cvs-serv8736 Modified Files: swank.lisp Log Message: Minor cleanups. (find-symbol-designator, find-symbol-or-lose, case-convert-input): Deleted. Replaced with calls to parse-symbol{-or-lose}. Date: Wed Jun 30 14:06:38 2004 Author: heller Index: slime/swank.lisp diff -u slime/swank.lisp:1.206 slime/swank.lisp:1.207 --- slime/swank.lisp:1.206 Tue Jun 29 10:46:58 2004 +++ slime/swank.lisp Wed Jun 30 14:06:38 2004 @@ -880,16 +880,21 @@ ;;;; Reading and printing -(defvar *buffer-package*) -(setf (documentation '*buffer-package* 'symbol) - "Package corresponding to slime-buffer-package. +(defmacro define-special (name doc) + "Define a special variable NAME with doc string DOC. +This is like defvar, but NAME will not initialized." + `(progn + (defvar ,name) + (setf (documentation ',name 'symbol) ',doc))) + +(define-special *buffer-package* + "Package corresponding to slime-buffer-package. EVAL-FOR-EMACS binds *buffer-package*. Strings originating from a slime buffer are best read in this package. See also FROM-STRING and TO-STRING.") -(defvar *buffer-readtable*) -(setf (documentation '*buffer-readtable* 'symbol) - "Readtable associated with the current buffer") +(define-special *buffer-readtable* + "Readtable associated with the current buffer") (defmacro with-buffer-syntax ((&rest _) &body body) "Execute BODY with appropriate *package* and *readtable* bindings. @@ -907,15 +912,23 @@ (let ((*read-suppress* nil)) (read-from-string string)))) -(defun parse-symbol (string) +(defun parse-symbol (string &optional (package *package*)) "Find the symbol named STRING. -Return the symbol and a flag indicate if the symbols was found." +Return the symbol and a flag indicateing if the symbols was found." (multiple-value-bind (sym pos) (let ((*package* keyword-package)) (ignore-errors (read-from-string string))) (if (and (symbolp sym) (eql (length string) pos)) - (find-symbol (string sym)) + (if (find #\: string) + (find-symbol (string sym) (symbol-package sym)) + (find-symbol (string sym) package)) (values nil nil)))) +(defun parse-symbol-or-lose (string &optional (package *package*)) + (multiple-value-bind (symbol status) (parse-symbol string package) + (if status + (values symbol status) + (error "Unknown symbol: ~A [in ~A]" string package)))) + (defun parse-package (string) "Find the package named STRING. Return the package or nil." @@ -951,45 +964,20 @@ default) default))) -(defun find-symbol-designator (string &optional - (default-package *buffer-package*)) - "Return the symbol corresponding to the symbol designator STRING. -If string is not package qualified use DEFAULT-PACKAGE for the -resolution. Return nil if no such symbol exists." - (multiple-value-bind (name package-name internal-p) - (tokenize-symbol-designator (case-convert-input string)) - (cond ((and package-name (not (find-package package-name))) - (values nil nil)) - (t - (let ((package (or (find-package package-name) default-package))) - (multiple-value-bind (symbol access) (find-symbol name package) - (cond ((and package-name (not internal-p) - (not (eq access :external))) - (values nil nil)) - (access (values symbol access))))))))) - -(defun find-symbol-or-lose (string &optional - (default-package *buffer-package*)) - "Like FIND-SYMBOL-DESIGNATOR but signal an error the symbols doesn't -exists." - (multiple-value-bind (symbol package) - (find-symbol-designator string default-package) - (cond (package (values symbol package)) - (t (error "Unknown symbol: ~S [in ~A]" string default-package))))) - (defun valid-operator-name-p (string) "Test if STRING names a function, macro, or special-operator." - (let ((symbol (find-symbol-designator string))) + (let ((symbol (parse-symbol string))) (or (fboundp symbol) (macro-function symbol) (special-operator-p symbol)))) (defslimefun arglist-for-echo-area (names) "Return the arglist for the first function, macro, or special-op in NAMES." - (let ((name (find-if #'valid-operator-name-p names))) - (if name - (format-arglist-for-echo-area (find-symbol-designator name) name) - ""))) + (with-buffer-syntax () + (let ((name (find-if #'valid-operator-name-p names))) + (if name + (format-arglist-for-echo-area (parse-symbol name) name) + "")))) (defun format-arglist-for-echo-area (symbol name) "Return SYMBOL's arglist as string for display in the echo area. @@ -1043,15 +1031,16 @@ ;; (assert (test-print-arglist '(&key ((function f))) "(&key ((function f)))")) (defslimefun arglist-for-insertion (name) - (cond ((valid-operator-name-p name) - (let ((arglist (arglist (find-symbol-designator name)))) - (etypecase arglist - ((member :not-available) - " ") - (list - (format nil "~{~^ ~A~})" (list arglist)))))) - (t - " "))) + (with-buffer-syntax () + (cond ((valid-operator-name-p name) + (let ((arglist (arglist (parse-symbol name)))) + (etypecase arglist + ((member :not-available) + " ") + (list + (format nil "~{~^ ~A~})" (list arglist)))))) + (t + " ")))) ;;;; Debugger @@ -1268,7 +1257,7 @@ (defun eval-for-emacs (form buffer-package id) "Bind *BUFFER-PACKAGE* BUFFER-PACKAGE and evaluate FORM. -Return the result values as a list to strings to the continuation ID. +Return the result to the continuation ID. Errors are trapped and invoke our debugger." (let ((*debugger-hook* #'swank-debugger-hook)) (let (ok result) @@ -1548,19 +1537,6 @@ (values (some #'lower-case-p string) (some #'upper-case-p string))) -(defun case-convert-input (string) - "Convert STRING according to the current readtable-case." - (check-type string string) - (ecase (readtable-case *readtable*) - (:upcase (string-upcase string)) - (:downcase (string-downcase string)) - (:preserve string) - (:invert (multiple-value-bind (lower upper) (determine-case string) - (cond ((and upper lower) string) - (lower (string-upcase string)) - (upper (string-downcase string)) - (t string)))))) - (defun carefully-find-package (name default-package-name) "Find the package with name NAME, or DEFAULT-PACKAGE-NAME, or the *buffer-package*. NAME and DEFAULT-PACKAGE-NAME can be nil." @@ -2110,11 +2086,6 @@ (intern "Foo" p) (intern "FOO" p) (setf (readtable-case *readtable*) :invert) - (assert (string= (case-convert-input "f") "F")) - (assert (string= (case-convert-input "foo") "FOO")) - (assert (string= (case-convert-input "Foo") "Foo")) - (assert (string= (case-convert-input "FOO") "foo")) - (assert (string= (case-convert-input "find-if") "FIND-IF")) (flet ((names (prefix) (sort (mapcar #'symbol-name (find-matching-symbols prefix p nil #'prefix-match-p)) @@ -2218,25 +2189,34 @@ (push symbol result)))))) result)) -(defun describe-to-string (object) +(defun call-with-describe-settings (fn) (let ((*print-readably* nil)) + (funcall fn))) + +(defmacro with-describe-settings ((&rest _) &body body) + (declare (ignore _)) + `(call-with-describe-settings (lambda () , at body))) + +(defun describe-to-string (object) + (with-describe-settings () (with-output-to-string (*standard-output*) (describe object)))) (defslimefun describe-symbol (symbol-name) (with-buffer-syntax () - (describe-to-string (find-symbol-or-lose symbol-name)))) + (describe-to-string (parse-symbol-or-lose symbol-name)))) (defslimefun describe-function (name) (with-buffer-syntax () - (let ((symbol (find-symbol name))) + (let ((symbol (parse-symbol-or-lose name))) (describe-to-string (or (macro-function symbol) (symbol-function symbol)))))) (defslimefun describe-definition-for-emacs (name kind) (with-buffer-syntax () - (with-output-to-string (*standard-output*) - (describe-definition (find-symbol-or-lose name) kind)))) + (with-describe-settings () + (with-output-to-string (*standard-output*) + (describe-definition (parse-symbol-or-lose name) kind))))) (defslimefun documentation-symbol (symbol-name &optional default) (with-buffer-syntax () @@ -2376,7 +2356,7 @@ errors)))))))) (defslimefun xref (type symbol-name) - (let ((symbol (find-symbol-or-lose symbol-name))) + (let ((symbol (parse-symbol-or-lose symbol-name))) (group-xrefs (ecase type (:calls (who-calls symbol)) From heller at common-lisp.net Wed Jun 30 21:09:56 2004 From: heller at common-lisp.net (Helmut Eller) Date: Wed, 30 Jun 2004 14:09:56 -0700 Subject: [slime-cvs] CVS update: slime/slime.el Message-ID: Update of /project/slime/cvsroot/slime In directory common-lisp.net:/tmp/cvs-serv31074 Modified Files: slime.el Log Message: (slime-display-compilation-output): New customizable variable. Date: Wed Jun 30 14:09:56 2004 Author: heller Index: slime/slime.el diff -u slime/slime.el:1.351 slime/slime.el:1.352 --- slime/slime.el:1.351 Wed Jun 30 13:55:33 2004 +++ slime/slime.el Wed Jun 30 14:09:56 2004 @@ -497,7 +497,7 @@ (defun slime-nop () "The null command. Used to shadow currently-unused keybindings." (interactive) - nil) + (call-interactively 'undefined)) (defvar slime-doc-map (make-sparse-keymap) "Keymap for documentation commands. Bound to a prefix key.") @@ -2832,6 +2832,11 @@ ;;; Compilation and the creation of compiler-note annotations +(defcustom slime-display-compilation-output t + "If true display the output buffer before compiling files." + :type '(choice (const :tag "Enable" t) (const :tag "Disable" nil)) + :group 'slime) + (defun slime-compile-and-load-file () "Compile and load the buffer's file and highlight compiler notes. @@ -2858,7 +2863,8 @@ (let ((lisp-filename (slime-to-lisp-filename (buffer-file-name)))) (slime-insert-transcript-delimiter (format "Compile file %s" lisp-filename)) - (slime-display-output-buffer) + (when slime-display-compilation-output + (slime-display-output-buffer)) (slime-eval-async `(swank:compile-file-for-emacs ,lisp-filename ,(if load t nil)) nil @@ -6488,9 +6494,9 @@ ;;; Font Lock (defcustom slime-highlight-suppressed-forms t - "If enabled highlight reader conditionalized forms if the test is false." + "If enabled display reader conditionalized forms as comments." :type '(choice (const :tag "Enable" t) (const :tag "Disable" nil)) - :group 'slime) + :group 'slime-mode) (defun slime-search-suppressed-forms (limit) "Find reader conditionalized forms where the test is false." From heller at common-lisp.net Wed Jun 30 21:11:43 2004 From: heller at common-lisp.net (Helmut Eller) Date: Wed, 30 Jun 2004 14:11:43 -0700 Subject: [slime-cvs] CVS update: slime/ChangeLog Message-ID: Update of /project/slime/cvsroot/slime In directory common-lisp.net:/tmp/cvs-serv21345 Modified Files: ChangeLog Log Message: *** empty log message *** Date: Wed Jun 30 14:11:43 2004 Author: heller Index: slime/ChangeLog diff -u slime/ChangeLog:1.448 slime/ChangeLog:1.449 --- slime/ChangeLog:1.448 Wed Jun 30 11:57:37 2004 +++ slime/ChangeLog Wed Jun 30 14:11:43 2004 @@ -1,3 +1,13 @@ +2004-06-30 Helmut Eller + + * slime.el (slime-display-compilation-output): New customizable + variable. + + * swank.lisp: Minor cleanups. + (find-symbol-designator, find-symbol-or-lose) + (case-convert-input): Deleted. Replaced with calls to + parse-symbol{-or-lose}. + 2004-06-30 Luke Gorrie * slime.el (slime-read-port-and-connect-to-running-swank) @@ -66,19 +76,19 @@ * swank-allegro.lisp (nth-frame): Skip frames where frame-visible-p is false. - * slime.el (slime-buffer-package): Return the cached package if - can't something more sensible; this reverts a previous change. - The Lisp side will now fall back to an existing package if the one - supplied by Emacs doesn't exist. Using the cached version is also - necessary for some commands in the apropos buffer. + * slime.el (slime-buffer-package): Return the cached package if we + can't find something more sensible; this reverts a previous + change. The Lisp side will now fall back to an existing package + if the one supplied by Emacs doesn't exist. Using the cached + version is also necessary for some commands in the apropos buffer. (sldb-insert-frame): Set the default-action property; pressing RET on frame lines now shows/hides details. (sldb-toggle-details): Preserve the current column. (slime-inspector-buffer, slime-saved-window-config) (slime-inspector-quit): Save and restore the window configuration. (slime-highlight-suppressed-forms, slime-search-suppressed-forms): - Display expressions with reader conditionals (#+/#-) where the - test is false in font-lock-comment-face. No implemented for + Display expressions with reader conditionals (#+/#-) in + font-lock-comment-face if the test is false. Not implemented for XEmacs. (repl-return): New test. From heller at common-lisp.net Wed Jun 30 21:45:07 2004 From: heller at common-lisp.net (Helmut Eller) Date: Wed, 30 Jun 2004 14:45:07 -0700 Subject: [slime-cvs] CVS update: slime/swank-lispworks.lisp Message-ID: Update of /project/slime/cvsroot/slime In directory common-lisp.net:/tmp/cvs-serv28968 Modified Files: swank-lispworks.lisp Log Message: (describe-symbol-for-emacs): Include information about setf-functions stuff. (emacs-connected): Add a default method to defenv-internals:environment-display-debugger. Date: Wed Jun 30 14:45:07 2004 Author: heller Index: slime/swank-lispworks.lisp diff -u slime/swank-lispworks.lisp:1.48 slime/swank-lispworks.lisp:1.49 --- slime/swank-lispworks.lisp:1.48 Sun Jun 27 08:00:43 2004 +++ slime/swank-lispworks.lisp Wed Jun 30 14:45:07 2004 @@ -25,6 +25,10 @@ stream:stream-line-column )) +(when (fboundp 'dspec::define-form-parser) + (dspec::define-form-parser defimplementation (name args &rest body) + `(defmethod ,name ,args , at body))) + ;;; TCP server (defimplementation preferred-communication-style () @@ -76,7 +80,10 @@ (env &key restarts condition) (declare (ignore restarts)) (funcall (find-symbol (string :swank-debugger-hook) :swank) - condition *debugger-hook*)))) + condition *debugger-hook*)) + (defmethod env-internals:environment-display-debugger + (env) + *debug-io*))) ;;; Unix signals @@ -145,6 +152,10 @@ (not (generic-function-p (fdefinition symbol)))) (doc 'function))) (maybe-push + :setf (let ((setf-name (sys:underlying-setf-name `(setf ,symbol)))) + (if (fboundp setf-name) + (doc 'setf)))) + (maybe-push :class (if (find-class symbol nil) (doc 'class))) result))) @@ -153,7 +164,8 @@ (ecase type (:variable (describe-symbol symbol)) (:class (describe (find-class symbol))) - ((:function :generic-function) (describe-function symbol)))) + ((:function :generic-function) (describe-function symbol)) + (:setf (describe-function (sys:underlying-setf-name `(setf ,symbol)))))) (defun describe-function (symbol) (cond ((fboundp symbol) From heller at common-lisp.net Wed Jun 30 21:47:14 2004 From: heller at common-lisp.net (Helmut Eller) Date: Wed, 30 Jun 2004 14:47:14 -0700 Subject: [slime-cvs] CVS update: slime/ChangeLog Message-ID: Update of /project/slime/cvsroot/slime In directory common-lisp.net:/tmp/cvs-serv15111 Modified Files: ChangeLog Log Message: *** empty log message *** Date: Wed Jun 30 14:47:14 2004 Author: heller Index: slime/ChangeLog diff -u slime/ChangeLog:1.449 slime/ChangeLog:1.450 --- slime/ChangeLog:1.449 Wed Jun 30 14:11:43 2004 +++ slime/ChangeLog Wed Jun 30 14:47:14 2004 @@ -8,6 +8,11 @@ (case-convert-input): Deleted. Replaced with calls to parse-symbol{-or-lose}. + * swank-lispworks.lisp (describe-symbol-for-emacs): Include + information about setf-functions. + (emacs-connected): Add a default method to + defenv-internals:environment-display-debugger. + 2004-06-30 Luke Gorrie * slime.el (slime-read-port-and-connect-to-running-swank) From lgorrie at common-lisp.net Wed Jun 30 22:08:23 2004 From: lgorrie at common-lisp.net (Luke Gorrie) Date: Wed, 30 Jun 2004 15:08:23 -0700 Subject: [slime-cvs] CVS update: slime/doc/slime.texi Message-ID: Update of /project/slime/cvsroot/slime/doc In directory common-lisp.net:/tmp/cvs-serv5359/doc Modified Files: slime.texi Log Message: General updatings for an alpha release. Date: Wed Jun 30 15:08:22 2004 Author: lgorrie Index: slime/doc/slime.texi diff -u slime/doc/slime.texi:1.17 slime/doc/slime.texi:1.18 --- slime/doc/slime.texi:1.17 Sun Jun 27 08:05:13 2004 +++ slime/doc/slime.texi Wed Jun 30 15:08:22 2004 @@ -45,8 +45,8 @@ @code{\command\}@* @end macro - at set EDITION DRAFT - at set UPDATED @code{$Id: slime.texi,v 1.17 2004/06/27 15:05:13 heller Exp $} + at set EDITION 1.0 (alpha1) + at set UPDATED @code{$Date: 2004/06/30 22:08:22 $} @titlepage @title SLIME User Manual @@ -92,7 +92,12 @@ * Installation:: * Running:: -Downloading @SLIME{} (from @CVS{}) +Downloading SLIME + +* CVS:: +* CVS Incantations:: + +Downloading from CVS * CVS Incantations:: @@ -105,6 +110,7 @@ User-interface conventions * Temporary buffers:: +* Key bindings:: * inferior-lisp:: Commands @@ -119,13 +125,13 @@ * Inspector:: * Profiling:: - at REPL{}: the ``top level'' +REPL: the ``top level'' * REPL commands:: * Input Navigation:: * Shortcuts:: - at SLDB{}: the @SLIME{} debugger +SLDB: the SLIME debugger * Examining frames:: * restarts:: @@ -182,28 +188,6 @@ well-defined interface and implemented separately for each Lisp implementation. This makes @SLIME{} readily portable. - at c @node Status, , Introduction, Introduction - at section Status: under development - - at SLIME{} is a program under development and has not yet been -``released.'' Unlike many other free software projects, we are not -making ``0.x'' releases, but instead evolving directly towards a -``1.0'' release. We find this continuous style of development very -comfortable, so rather than setting short-term milestones we've taken -to merrily hacking away as @SLIME{} progresses towards a ``final'' -shape at its own pace. - -We warmly invite Lisp hackerdom to join in the development in any way -you like. As frugal hospitality we offer access to the @CVS{} tree and -a cosy mailing list, but not yet such luxuries as supported tarballs, -a snazzy website, or guarantees of backward-compatibility. - -We hope that nowadays @SLIME{} is suitable for doing ``real work'' -with. To make support easy we do expect @SLIME{} users to keep fairly -up-to-date with the current code-base, so an adventurous nature is an -advantage. For people looking for something to just install and not -have to upgrade or muck about with, we ain't yet it. - @node Getting started, slime-mode, Introduction, Top @chapter Getting started @@ -224,7 +208,8 @@ Windows. GNU Emacs versions 20 and 21 and XEmacs version 21 are supported. -The supported Lisp implementations are: +The supported Lisp implementations, roughly ordered from the +best-supported, are: @itemize @bullet @item @@ -234,12 +219,12 @@ @item OpenMCL @item - at acronym{CLISP} - at item LispWorks @item Allegro Common Lisp (@acronym{ACL}) @item + at acronym{CLISP} + at item Armed Bear Common Lisp (@acronym{ABCL}) @end itemize @@ -249,7 +234,24 @@ commands (like ``restart frame''). @node Downloading, Installation, Platforms, Getting started - at section Downloading SLIME (from CVS) + at section Downloading SLIME + +You can choose between using a released version of @SLIME{} or +accessing our @CVS{} repository directly. You can download the latest +released version from our website: + + at url{http://www.common-lisp.net/project/slime/} + +We recommend that users who participate in the @code{slime-devel} +mailing list use the @CVS{} version of the code. + + at menu +* CVS:: +* CVS Incantations:: + at end menu + + at node CVS, CVS Incantations, Downloading, Downloading + at subsection Downloading from CVS @SLIME{} is available from the @CVS{} repository on @file{common-lisp.net}. You have the option to use either the very @@ -261,19 +263,19 @@ you follow the @code{slime-devel} mailing list then you're better off with the latest version (we'll send a note when it's undergoing major hacking). If you don't follow the mailing list you won't know the -status of the latest code, so tracking @code{FAIRLY-STABLE} is the -safe option. +status of the latest code, so tracking @code{FAIRLY-STABLE} or using a +released version is the safe option. -In either case remember to @code{cvs update} occasionally. -Improvements are continually being committed, and the +If you checkout from @CVS{} then remember to @code{cvs update} +occasionally. Improvements are continually being committed, and the @code{FAIRLY-STABLE} tag is moved forward from time to time (about -once or twice per month). +once per month). @menu * CVS Incantations:: @end menu - at node CVS Incantations, , Downloading, Downloading + at node CVS Incantations, , CVS, Downloading @subsection CVS incantations To download @SLIME{} you first configure your @code{CVSROOT} and login @@ -357,10 +359,11 @@ @menu * Temporary buffers:: +* Key bindings:: * inferior-lisp:: @end menu - at node Temporary buffers, inferior-lisp, User-interface conventions, User-interface conventions + at node Temporary buffers, Key bindings, User-interface conventions, User-interface conventions @subsection Temporary buffers Some @SLIME{} commands create temporary buffers to display their @@ -385,7 +388,20 @@ @SLIME{} commands available for describing symbols, looking up function definitions, and so on. - at node inferior-lisp, , Temporary buffers, User-interface conventions + at node Key bindings, inferior-lisp, Temporary buffers, User-interface conventions + at subsection Key bindings + +In general we try to make our key bindings fit with the overall Emacs +style. We also have the following somewhat unusual convention of our +own: when entering a three-key sequence, the final key can be pressed +either with control or unmodified. For example, the + at code{slime-describe-symbol} command is bound to @kbd{C-c C-d d}, but +it also works to type @kbd{C-c C-d C-d}. We're simply binding both key +sequences because some people like to hold control for all three keys +and others don't, and with the two-key prefix we're not afraid of +running out of keys. + + at node inferior-lisp, , Key bindings, User-interface conventions @subsection @code{*inferior-lisp*} buffer @SLIME{} internally uses the @code{inferior-lisp} package to start @@ -516,30 +532,37 @@ @subsection Documentation @SLIME{}'s online documentation commands follow the example of Emacs -Lisp. +Lisp. The commands all share the common prefix @kbd{C-c C-d} and allow +the final key to be modified or unmodified (@xref{Key bindings}.) @table @kbd - at kbditem{C-c C-d, slime-describe-symbol} + at kbditem{C-c C-d d, slime-describe-symbol} Describe the symbol at point. - at kbditem{C-c C-a, slime-apropos} + at kbditem{C-c C-d a, slime-apropos} Apropos search. Search Lisp symbol names for a substring match and present their documentation strings. By default the external symbols of all packages are searched. With a prefix argument you can choose a specific package and whether to include unexported symbols. - at kbditem{C-c P, slime-apropos-package} + at kbditem{C-c C-d z, slime-apropos-all} +Like @code{slime-apropos} but also includes internal symbols by default. + + at kbditem{C-c C-d p, slime-apropos-package} Show apropos results of all symbols in a package. This command is for browsing a package at a high-level. With package-name completion it also serves as a rudimentary Smalltalk-ish image-browser. - at kbditem{C-c C-h, slime-hyperspec-lookup} + at kbditem{C-c C-d h, slime-hyperspec-lookup} Lookup the symbol at point in the @cite{Common Lisp Hyperspec}. This uses the familiar @file{hyperspec.el} to show the appropriate section in a web browser. The Hyperspec is found either on the Web or in @code{common-lisp-hyperspec-root}, and the browser is selected by @code{browse-url-browser-function}. + + at kbditem{C-c C-d ~, common-lisp-hyperspec-format} +Lookup a format character in the @cite{Common Lisp Hyperspec}. @end table @node Programming Helpers, Recovery, Documentation, Commands @@ -612,7 +635,9 @@ Repository} and bundled with @SLIME{}. Each command operates on the symbol at point, or prompts if there is -none. With a prefix argument they always prompt. +none. With a prefix argument they always prompt. You can either enter +the key bindings as shown here or with the control modified on the +last key, @xref{Key bindings}. @table @kbd @@ -743,6 +768,13 @@ You can use @kbd{M-x slime-update-indentation} to force all symbols to be scanned for indentation information. + at node Reader conditionals + at section Reader conditional fontification + + at SLIME{} automatically evaluates reader-conditional expressions in +source buffers and ``grays out'' code that will be skipped for the +current Lisp connection. + @node REPL, Debugger, slime-mode, Top @chapter REPL: the ``top level'' @@ -1099,14 +1131,10 @@ @node Emacs-side customization, Lisp-side, Customization, Customization @section Emacs-side -The Emacs part of @SLIME{} can be configured both with the Emacs - at code{customize} system and with Lisp snippets. To customize -interactively, use @kbd{M-x customize-group slime RET}. The - at code{customize} interface is especially convenient for changing -colour schemes. The remainder of this section focuses on customizing -variables using Lisp code. - -Some variables affecting @SLIME{}'s operation are: +The Emacs part of @SLIME{} can be configured with the Emacs + at code{customize} system, just use @kbd{M-x customize-group slime +RET}. Because the customize system is self-describing, we only cover a +few important or obscure configuration options here in the manual. @table @code @@ -1116,6 +1144,11 @@ ensures that lines do not wrap in backtraces, apropos listings, and so on. It can however cause information to spill off the screen. + at item slime-multiprocessing +This should be set to @code{t} if you want to use multiprocessing +(threads) in your Lisp system. It causes any necessary initialization +to be performed during Lisp server startup. + @item slime-complete-symbol-function The function to use for completion of Lisp symbols. Three completion styles are available. The default @code{slime-complete-symbol*} @@ -1146,11 +1179,6 @@ It also has its own keybinding, defaulting to @kbd{C-c M-i}. @xref{slime-fuzzy-complete-symbol}, for more information. - at item slime-multiprocessing -This should be set to @code{t} if you want to use multiprocessing -(threads) in your Lisp system. It causes any necessary initialization -to be performed during Lisp server startup. - @item slime-translate-to-lisp-filename-function @itemx slime-translate-from-lisp-filename-function These functions can be used to translate filenames between Emacs and @@ -1264,13 +1292,23 @@ @table @code - at item SWANK:*LOG-EVENTS* -Setting this variable to @code{t} causes all protocol messages -exchanged with Emacs to be printed to @code{*TERMINAL-IO*}. This is -useful for low-level debugging and for observing how @SLIME{} works -``on the wire.'' The output of @code{*TERMINAL-IO*} can be found in -your Lisp system's own listener, usually in the buffer - at code{*inferior-lisp*}. + at item SWANK:*CONFIGURE-EMACS-INDENTATION* +This variable controls whether indentation styles for + at code{&body}-arguments in macros are discovered and sent to Emacs. It +is enabled by default. + + at item SWANK:*GLOBALLY-REDIRECT-IO* +When true this causes the standard streams (@code{*standard-output*}, +etc) to be globally redirected to the @REPL{} in Emacs. When + at code{NIL} (the default) these streams are only temporarily redirected +to Emacs using dynamic bindings while handling requests. Note that + at code{*standard-input*} is currently never globally redirected into +Emacs, because it can interact badly with the Lisp's native @REPL{} by +having it try to read from the Emacs one. + + at item SWANK:*SLDB-PPRINT-FRAMES* + at code{*PRINT-PRETTY*} is bound to this value while formatting +backtraces in @SLDB{}. The default value is @code{NIL}. @item SWANK:*USE-DEDICATED-OUTPUT-STREAM* This variable controls an optimization for sending printed output from @@ -1280,6 +1318,14 @@ protocol-messages to Emacs which must then be decoded, and this doesn't always keep up if Lisp starts ``spewing'' copious output. + at item SWANK:*LOG-EVENTS* +Setting this variable to @code{t} causes all protocol messages +exchanged with Emacs to be printed to @code{*TERMINAL-IO*}. This is +useful for low-level debugging and for observing how @SLIME{} works +``on the wire.'' The output of @code{*TERMINAL-IO*} can be found in +your Lisp system's own listener, usually in the buffer + at code{*inferior-lisp*}. + @end table @node Credits, , Customization, Top @@ -1311,11 +1357,9 @@ @code{cmucl-imp} list, Dan Barlow at footnote{Dan is one of ``us'', so naturally these thanks apply to the @acronym{SBCL}-hacker side of his personality.} and Christophe Rhodes of @acronym{SBCL}, Gary Byers of -OpenMCL, Peter Graves of @acronym{ABCL} and Martin Simmons of -LispWorks (generously sponsored by Alain Picard of Memetrics). - -And thanks in advance to the Lisp maintainers who we haven't -approached yet.. @code{:-)} +OpenMCL, Martin Simmons of LispWorks (generously sponsored by Alain +Picard of Memetrics), Peter Graves of @acronym{ABCL}, and to Craig +Norvell and Kevin Layer of Franz. @bye From lgorrie at common-lisp.net Wed Jun 30 22:17:53 2004 From: lgorrie at common-lisp.net (Luke Gorrie) Date: Wed, 30 Jun 2004 15:17:53 -0700 Subject: [slime-cvs] CVS update: slime/NEWS Message-ID: Update of /project/slime/cvsroot/slime In directory common-lisp.net:/tmp/cvs-serv22602 Modified Files: NEWS Log Message: Added security note about the TCP server. Added notes for ACL and ABCL. Date: Wed Jun 30 15:17:53 2004 Author: lgorrie Index: slime/NEWS diff -u slime/NEWS:1.3 slime/NEWS:1.4 --- slime/NEWS:1.3 Tue Jun 29 23:59:04 2004 +++ slime/NEWS Wed Jun 30 15:17:53 2004 @@ -1,6 +1,6 @@ * SLIME News -*- outline -*- -* 1.0 alpha-1 (June 2004) +* 1.0 alpha (June 2004) This preview release of SLIME is a precursor for an upcoming 1.0 release. We're planning to use our "alpha period" to introduce SLIME @@ -14,6 +14,13 @@ change something please try to get your patch applied before the end of July. +Security note: SLIME has Lisp open a one-use TCP listen socket for +Emacs to connect to for setting up communication. With all Lisps +except CLISP and ABCL this socket is bound to the loopback interface +and thus inaccessible to remote hosts. Be aware that if an attacker +connected to this server port before Emacs then he could have the Lisp +process execute arbitrary code. + ** Supported Lisp implementations Below is a list of the Lisp implementations that we support and their @@ -82,6 +89,10 @@ *** Allegro CL +We support Allegro Common Lisp version 5.0 and higher. The support is +quite complete, though it hasn't yet been used as heavily as the Lisps +listed above. + *** CLISP We support CLISP version 2.32 or newer. You'll need a version with @@ -94,4 +105,7 @@ directory as the source file. *** Armed Bear Common Lisp + +We have new and experimental support for the latest CVS version of +ABCL. From lgorrie at common-lisp.net Wed Jun 30 22:18:21 2004 From: lgorrie at common-lisp.net (Luke Gorrie) Date: Wed, 30 Jun 2004 15:18:21 -0700 Subject: [slime-cvs] CVS update: slime/mkdist.sh Message-ID: Update of /project/slime/cvsroot/slime In directory common-lisp.net:/tmp/cvs-serv23772 Modified Files: mkdist.sh Log Message: Changed version number to 1.0alpha Date: Wed Jun 30 15:18:21 2004 Author: lgorrie Index: slime/mkdist.sh diff -u slime/mkdist.sh:1.2 slime/mkdist.sh:1.3 --- slime/mkdist.sh:1.2 Tue Jun 29 15:12:53 2004 +++ slime/mkdist.sh Wed Jun 30 15:18:21 2004 @@ -1,5 +1,5 @@ #!/bin/sh -version="1.0alpha0" +version="1.0alpha" dist="slime-$version" if [ -d $dist ]; then rm -rf $dist; fi From lgorrie at common-lisp.net Wed Jun 30 22:25:14 2004 From: lgorrie at common-lisp.net (Luke Gorrie) Date: Wed, 30 Jun 2004 15:25:14 -0700 Subject: [slime-cvs] CVS update: slime/doc/slime.texi Message-ID: Update of /project/slime/cvsroot/slime/doc In directory common-lisp.net:/tmp/cvs-serv15777 Modified Files: slime.texi Log Message: C-c C-u C-a, C-c C-u C-e Date: Wed Jun 30 15:25:14 2004 Author: lgorrie Index: slime/doc/slime.texi diff -u slime/doc/slime.texi:1.18 slime/doc/slime.texi:1.19 --- slime/doc/slime.texi:1.18 Wed Jun 30 15:08:22 2004 +++ slime/doc/slime.texi Wed Jun 30 15:25:13 2004 @@ -45,8 +45,8 @@ @code{\command\}@* @end macro - at set EDITION 1.0 (alpha1) - at set UPDATED @code{$Date: 2004/06/30 22:08:22 $} + at set EDITION 1.0 alpha + at set UPDATED @code{$Date: 2004/06/30 22:25:13 $} @titlepage @title SLIME User Manual @@ -106,6 +106,7 @@ * User-interface conventions:: * Commands:: * Semantic indentation:: +* Reader conditionals:: User-interface conventions @@ -348,6 +349,7 @@ * User-interface conventions:: * Commands:: * Semantic indentation:: +* Reader conditionals:: @end menu @node User-interface conventions, Commands, slime-mode, slime-mode @@ -723,7 +725,7 @@ Reset profiler data. @end table - at node Semantic indentation, , Commands, slime-mode + at node Semantic indentation, Reader conditionals, Commands, slime-mode @section Semantic indentation @SLIME{} automatically discovers how to indent the macros in your Lisp @@ -768,7 +770,7 @@ You can use @kbd{M-x slime-update-indentation} to force all symbols to be scanned for indentation information. - at node Reader conditionals + at node Reader conditionals, , Semantic indentation, slime-mode @section Reader conditional fontification @SLIME{} automatically evaluates reader-conditional expressions in From lgorrie at common-lisp.net Wed Jun 30 23:07:18 2004 From: lgorrie at common-lisp.net (Luke Gorrie) Date: Wed, 30 Jun 2004 16:07:18 -0700 Subject: [slime-cvs] CVS update: slime/slime.el Message-ID: Update of /project/slime/cvsroot/slime In directory common-lisp.net:/tmp/cvs-serv8613 Modified Files: slime.el Log Message: (sldb-lookup-reference): Preserve case in SBCL node names. Previously they were downcased, but the HTML manual's filenames seem to have changed. Date: Wed Jun 30 16:07:18 2004 Author: lgorrie Index: slime/slime.el diff -u slime/slime.el:1.352 slime/slime.el:1.353 --- slime/slime.el:1.352 Wed Jun 30 14:09:56 2004 +++ slime/slime.el Wed Jun 30 16:07:18 2004 @@ -5548,7 +5548,7 @@ (slime-cl-symbol-name what) what))))) (t - (let ((url (format "%s%s.html" slime-sbcl-manual-root (downcase what)))) + (let ((url (format "%s%s.html" slime-sbcl-manual-root what))) (browse-url url)))))) (defun sldb-insert-restarts (restarts) From lgorrie at common-lisp.net Wed Jun 30 23:07:26 2004 From: lgorrie at common-lisp.net (Luke Gorrie) Date: Wed, 30 Jun 2004 16:07:26 -0700 Subject: [slime-cvs] CVS update: slime/ChangeLog Message-ID: Update of /project/slime/cvsroot/slime In directory common-lisp.net:/tmp/cvs-serv8965 Modified Files: ChangeLog Log Message: Date: Wed Jun 30 16:07:26 2004 Author: lgorrie Index: slime/ChangeLog diff -u slime/ChangeLog:1.450 slime/ChangeLog:1.451 --- slime/ChangeLog:1.450 Wed Jun 30 14:47:14 2004 +++ slime/ChangeLog Wed Jun 30 16:07:26 2004 @@ -1,3 +1,14 @@ +2004-07-01 Luke Gorrie + + * slime.el (sldb-lookup-reference): Preserve case in SBCL node + names. Previously they were downcased, but the HTML manual's + filenames seem to have changed. + + * NEWS: Added security note about the TCP server. + Added notes for ACL and ABCL. + + * doc/slime.texi: General updatings for an alpha release. + 2004-06-30 Helmut Eller * slime.el (slime-display-compilation-output): New customizable @@ -20,6 +31,8 @@ with "127.0.0.1". This is believed to avoid unwanted DNS lookups on certain operating systems. The lookups can become crippling if the DNS server isn't available. + (line-beginning-position, line-end-position): Simple bugfix + suggested by Richard Klinda. * swank-sbcl.lisp (preferred-communication-style): Choose :fd-handler instead of :sigio when threads aren't available. A lot