From mbaringer at common-lisp.net Fri Mar 3 15:02:19 2006 From: mbaringer at common-lisp.net (mbaringer) Date: Fri, 3 Mar 2006 10:02:19 -0500 (EST) Subject: [slime-cvs] CVS /slime Message-ID: <20060303150219.473A07E02D@common-lisp.net> Update of /project/slime/cvsroot//slime In directory clnet:/tmp/cvs-serv21811 Modified Files: slime.el Log Message: (slime-translate-to-lisp-filename-function): removed. (slime-translate-from-lisp-filename-function): removed. (slime-filename-translations): New variable. (slime-to-lisp-filename): Rewrote to search through available transalations. (slime-from-lisp-filename): idem. (slime-create-filename-translator): New function. (slime-add-filename-translation): New function. --- /project/slime/cvsroot//slime/slime.el 2006/02/27 19:15:52 1.590 +++ /project/slime/cvsroot//slime/slime.el 2006/03/03 15:02:18 1.591 @@ -152,17 +152,47 @@ :type 'hook :group 'slime-lisp) -(defcustom slime-translate-to-lisp-filename-function 'identity - "Function to use for translating Emacs filenames to Lisp filenames. -The function recieves a string as argument and should return string. -No suitable functions are ready-made, you have to write one yourself." - :type 'function - :group 'slime-lisp) +(defcustom slime-filename-translations '(("" + identity + identity)) + "Alist of mappings between machine names and filename +translation functions. Each element is of the +form (HOSTNAME-REGEXP TO-LISP FROM-LISP). + +HOSTNAME-REGEXP is a regexp which is applied to the connection's +slime-machine-instance. If HOSTNAME-REGEXP maches then the +corresponding TO-LISP and FROM-LISP functions will be used to +translate emacs filenames and lisp filenames. + +TO-LISP will be passed the filename of an emacs buffer and must +return a string which the underlying lisp understandas as a +pathname. FROM-LISP will be passed a pathname as returned by the +underlying lisp and must return something that emacs will +understand as a filename (this string will be passed to +find-file). + +The default value of the variable, ((\"\" identity identity)), +simply passes the name unchanged and is fine if emacs and the +lisp share the same file system. + +This list will be traversed in order, so multiple matching +regexps are possible. + +Example: + +Assuming you run emacs locally and connect to slime running on +the machine 'soren' and you can connect with the username +'animaliter': + + (push (list \"^soren$\" + (lambda (filename) + (concat \"/ssh:animaliter at soren:\" filename)) + (lambda (filename) + (subseq (length \"/ssh:animaliter at soren:\") filename))) + slime-filename-translations) -(defcustom slime-translate-from-lisp-filename-function 'identity - "Function to use for translating Lisp filenames to Emacs filenames. -See also `slime-translate-to-lisp-filename-function'." - :type 'function +See also `slime-create-filename-translator'." + :type 'list :group 'slime-lisp) (defcustom slime-enable-evaluate-in-emacs nil @@ -1223,15 +1253,64 @@ (defun slime-to-lisp-filename (filename) "Translate the string FILENAME to a Lisp filename. -See `slime-translate-to-lisp-filename-function'." - (funcall slime-translate-to-lisp-filename-function - ;; expand-file-name so that Lisp doesn't see ~foo/bar, etc - (expand-file-name filename))) +See `slime-filename-translations'." + (if (slime-connected-p) + (block slime-to-lisp-filename + (dolist (translation-spec slime-filename-translations) + (let ((hostname-regexp (car translation-spec)) + (to-lisp (first translation-spec))) + (when (string-match hostname-regexp (slime-machine-instance)) + (return-from slime-to-lisp-filename (funcall to-lisp filename))))) + (error "No elements in slime-filename-translations (%S) matched the connection's hostname (%S)" + slime-filename-translations + (slime-machine-instance))) + filename)) (defun slime-from-lisp-filename (filename) "Translate the Lisp filename FILENAME to an Emacs filename. -See `slime-translate-from-lisp-filename-function'." - (funcall slime-translate-from-lisp-filename-function filename)) +See `slime-filename-translations'." + (if (slime-connected-p) + (block slime-from-lisp-filename + (dolist (translation-spec slime-filename-translations) + (let ((hostname-regexp (car translation-spec)) + (from-lisp (second translation-spec))) + (when (string-match hostname-regexp (slime-machine-instance)) + (return-from slime-from-lisp-filename (funcall from-lisp filename))))) + (error "No elements in slime-filename-translations (%S) matched the connection's hostname (%S)" + slime-filename-translations + (slime-machine-instance))) + filename)) + +(defun* slime-create-filename-translator (&key machine-instance + remote-host + username) + "Creates a three element list suitable for push'ing onto +slime-filename-translations which uses tramp to load files on +hostname using username. MACHINE-INSTANCE is a required +parameter, REMOTE-HOST defaults to MACHINE-INSTANCE and USERNAME +defaults to (user-login-name). + +MACHINE-INSTANCE is the value returned by slime-machine-instance, +which is just the value returned by cl:machine-instance on the +remote lisp. REMOTE-HOST is the fully qualified domain name (or +just the IP) of the remote machine. USERNAME is the username we +sholud login with." + (setf remote-host (or remote-host machine-instance) + username (or username (user-login-name))) + (lexical-let ((tramp-prefix (concat "/ssh:" username "@" remote-host ":"))) + (list (concat "^" machine-instance "$") + `(lambda (filename) + (concat ,tramp-prefix filename)) + `(lambda (filename) + (subseq filename (length ,tramp-prefix)))))) + +(defun* slime-add-filename-translation (&key machine-instance + remote-host + username) + (push (slime-create-filename-translator :machine-instance machine-instance + :remote-host remote-host + :username username) + slime-filename-translations)) ;;;; Starting SLIME From mbaringer at common-lisp.net Fri Mar 3 15:03:32 2006 From: mbaringer at common-lisp.net (mbaringer) Date: Fri, 3 Mar 2006 10:03:32 -0500 (EST) Subject: [slime-cvs] CVS /slime Message-ID: <20060303150332.49F6943001@common-lisp.net> Update of /project/slime/cvsroot//slime In directory clnet:/tmp/cvs-serv21864 Modified Files: ChangeLog Log Message: --- /project/slime/cvsroot//slime/ChangeLog 2006/02/27 19:16:01 1.850 +++ /project/slime/cvsroot//slime/ChangeLog 2006/03/03 15:03:32 1.851 @@ -1,3 +1,17 @@ +2006-03-03 Marco Baringer + + Allow per-host (per machine-instance actually) filename + translation functions. + + * slime.el (slime-translate-to-lisp-filename-function): removed. + (slime-translate-from-lisp-filename-function): removed. + (slime-filename-translations): New variable. + (slime-to-lisp-filename): Rewrote to search through available + transalations. + (slime-from-lisp-filename): idem. + (slime-create-filename-translator): New function. + (slime-add-filename-translation): New function. + 2006-02-27 Matthias Koeppe * slime.el (slime-eval-macroexpand-inplace): Indent the inserted From mbaringer at common-lisp.net Fri Mar 3 15:03:31 2006 From: mbaringer at common-lisp.net (mbaringer) Date: Fri, 3 Mar 2006 10:03:31 -0500 (EST) Subject: [slime-cvs] CVS /slime/doc Message-ID: <20060303150331.1856E431B4@common-lisp.net> Update of /project/slime/cvsroot//slime/doc In directory clnet:/tmp/cvs-serv21864/doc Modified Files: slime.texi Log Message: --- /project/slime/cvsroot//slime/doc/slime.texi 2006/02/27 14:30:32 1.43 +++ /project/slime/cvsroot//slime/doc/slime.texi 2006/03/03 15:03:31 1.44 @@ -46,7 +46,7 @@ @end macro @set EDITION 1.2 - at set UPDATED @code{$Date: 2006/02/27 14:30:32 $} + at set UPDATED @code{$Date: 2006/03/03 15:03:31 $} @titlepage @title SLIME User Manual @@ -1342,13 +1342,12 @@ It also has its own keybinding, defaulting to @kbd{C-c M-i}. @xref{slime-fuzzy-complete-symbol}, for more information. - at item slime-translate-to-lisp-filename-function - at itemx slime-translate-from-lisp-filename-function -These functions can be used to translate filenames between Emacs and -the Lisp system. They are useful if you run Emacs and Lisp on separate -machines which share a common file system but use a different directory -structure (different ``mount points''). This is most common with - at acronym{SMB}-based file sharing. + at item slime-filename-translations +This variable controls filename translation between Emacs and the Lisp +system. It is useful if you run Emacs and Lisp on separate machines +which don't share a common file system or if they share the filessytem +but have different layouts, os is the case with @acronym{SMB}-based +file sharing. @item slime-net-coding-system If you want to transmit Unicode characters between Emacs and the Lisp From mbaringer at common-lisp.net Fri Mar 3 15:40:10 2006 From: mbaringer at common-lisp.net (mbaringer) Date: Fri, 3 Mar 2006 10:40:10 -0500 (EST) Subject: [slime-cvs] CVS /slime Message-ID: <20060303154010.043A362014@common-lisp.net> Update of /project/slime/cvsroot//slime In directory clnet:/tmp/cvs-serv25876 Modified Files: slime.el Log Message: --- /project/slime/cvsroot//slime/slime.el 2006/03/03 15:02:18 1.591 +++ /project/slime/cvsroot//slime/slime.el 2006/03/03 15:40:10 1.592 @@ -185,10 +185,10 @@ 'animaliter': (push (list \"^soren$\" - (lambda (filename) - (concat \"/ssh:animaliter at soren:\" filename)) - (lambda (filename) - (subseq (length \"/ssh:animaliter at soren:\") filename))) + (lambda (emacs-filename) + (subseq (length \"/ssh:animaliter at soren:\") filename)) + (lambda (lisp-filename) + (concat \"/ssh:animaliter at soren:\" filename))) slime-filename-translations) See also `slime-create-filename-translator'." @@ -1258,7 +1258,7 @@ (block slime-to-lisp-filename (dolist (translation-spec slime-filename-translations) (let ((hostname-regexp (car translation-spec)) - (to-lisp (first translation-spec))) + (to-lisp (second translation-spec))) (when (string-match hostname-regexp (slime-machine-instance)) (return-from slime-to-lisp-filename (funcall to-lisp filename))))) (error "No elements in slime-filename-translations (%S) matched the connection's hostname (%S)" @@ -1273,7 +1273,7 @@ (block slime-from-lisp-filename (dolist (translation-spec slime-filename-translations) (let ((hostname-regexp (car translation-spec)) - (from-lisp (second translation-spec))) + (from-lisp (third translation-spec))) (when (string-match hostname-regexp (slime-machine-instance)) (return-from slime-from-lisp-filename (funcall from-lisp filename))))) (error "No elements in slime-filename-translations (%S) matched the connection's hostname (%S)" @@ -1299,10 +1299,10 @@ username (or username (user-login-name))) (lexical-let ((tramp-prefix (concat "/ssh:" username "@" remote-host ":"))) (list (concat "^" machine-instance "$") - `(lambda (filename) - (concat ,tramp-prefix filename)) - `(lambda (filename) - (subseq filename (length ,tramp-prefix)))))) + `(lambda (emacs-filename) + (subseq filename (length ,tramp-prefix))) + `(lambda (lisp-filename) + (concat ,tramp-prefix filename))))) (defun* slime-add-filename-translation (&key machine-instance remote-host From mbaringer at common-lisp.net Sat Mar 4 20:13:25 2006 From: mbaringer at common-lisp.net (mbaringer) Date: Sat, 4 Mar 2006 15:13:25 -0500 (EST) Subject: [slime-cvs] CVS /slime Message-ID: <20060304201325.56D385000E@common-lisp.net> Update of /project/slime/cvsroot//slime In directory clnet:/tmp/cvs-serv1112 Modified Files: ChangeLog Log Message: --- /project/slime/cvsroot//slime/ChangeLog 2006/03/03 15:03:32 1.851 +++ /project/slime/cvsroot//slime/ChangeLog 2006/03/04 20:13:25 1.852 @@ -1,3 +1,8 @@ +2006-03-04 Wojciech Kaczmarek + + * slime.el (slime-filename-translations): Typo in example. + (slime-create-filename-translator): Typo in generated lambdas. + 2006-03-03 Marco Baringer Allow per-host (per machine-instance actually) filename From mbaringer at common-lisp.net Sat Mar 4 20:13:51 2006 From: mbaringer at common-lisp.net (mbaringer) Date: Sat, 4 Mar 2006 15:13:51 -0500 (EST) Subject: [slime-cvs] CVS /slime Message-ID: <20060304201351.8CBA452001@common-lisp.net> Update of /project/slime/cvsroot//slime In directory clnet:/tmp/cvs-serv1167 Modified Files: slime.el Log Message: (slime-filename-translations): Typo in example. (slime-create-filename-translator): Typo in generated lambdas. --- /project/slime/cvsroot//slime/slime.el 2006/03/03 15:40:10 1.592 +++ /project/slime/cvsroot//slime/slime.el 2006/03/04 20:13:51 1.593 @@ -186,9 +186,9 @@ (push (list \"^soren$\" (lambda (emacs-filename) - (subseq (length \"/ssh:animaliter at soren:\") filename)) + (subseq (length \"/ssh:animaliter at soren:\") emacs-filename)) (lambda (lisp-filename) - (concat \"/ssh:animaliter at soren:\" filename))) + (concat \"/ssh:animaliter at soren:\" lisp-filename))) slime-filename-translations) See also `slime-create-filename-translator'." @@ -1300,9 +1300,9 @@ (lexical-let ((tramp-prefix (concat "/ssh:" username "@" remote-host ":"))) (list (concat "^" machine-instance "$") `(lambda (emacs-filename) - (subseq filename (length ,tramp-prefix))) + (subseq emacs-filename (length ,tramp-prefix))) `(lambda (lisp-filename) - (concat ,tramp-prefix filename))))) + (concat ,tramp-prefix lisp-filename))))) (defun* slime-add-filename-translation (&key machine-instance remote-host From mbaringer at common-lisp.net Tue Mar 7 09:50:25 2006 From: mbaringer at common-lisp.net (mbaringer) Date: Tue, 7 Mar 2006 04:50:25 -0500 (EST) Subject: [slime-cvs] CVS /slime Message-ID: <20060307095025.F0A201C002@common-lisp.net> Update of /project/slime/cvsroot//slime In directory clnet:/tmp/cvs-serv1456 Modified Files: ChangeLog Log Message: --- /project/slime/cvsroot//slime/ChangeLog 2006/03/04 20:13:25 1.852 +++ /project/slime/cvsroot//slime/ChangeLog 2006/03/07 09:50:25 1.853 @@ -1,3 +1,8 @@ +2006-03-06 Nathan Bird + + * slime.el: (slime-create-filename-translator): use the tramp + methods for dissecting and building filenames. + 2006-03-04 Wojciech Kaczmarek * slime.el (slime-filename-translations): Typo in example. From mbaringer at common-lisp.net Tue Mar 7 09:51:52 2006 From: mbaringer at common-lisp.net (mbaringer) Date: Tue, 7 Mar 2006 04:51:52 -0500 (EST) Subject: [slime-cvs] CVS /slime Message-ID: <20060307095152.B12C722006@common-lisp.net> Update of /project/slime/cvsroot//slime In directory clnet:/tmp/cvs-serv1525 Modified Files: swank-openmcl.lisp Log Message: (slime-create-filename-translator): use the tramp methods for dissecting and building filenames. --- /project/slime/cvsroot//slime/swank-openmcl.lisp 2006/02/18 13:44:10 1.105 +++ /project/slime/cvsroot//slime/swank-openmcl.lisp 2006/03/07 09:51:52 1.106 @@ -466,7 +466,15 @@ (ccl::frame-supplied-args p lfun pc nil context) (declare (ignore count nclosed)) (let ((result nil)) - (loop for var in args + (loop named loop + for var = (cond + ((null args) + (return-from loop)) + ((atom args) + (prog1 + args + (setf args nil))) + (t (pop args))) for type in types for name in names do From mbaringer at common-lisp.net Tue Mar 7 16:59:42 2006 From: mbaringer at common-lisp.net (mbaringer) Date: Tue, 7 Mar 2006 11:59:42 -0500 (EST) Subject: [slime-cvs] CVS /slime Message-ID: <20060307165942.B0A5F42000@common-lisp.net> Update of /project/slime/cvsroot//slime In directory clnet:/tmp/cvs-serv21977 Modified Files: slime.el Log Message: * slime.el: (slime-create-filename-translator): use the tramp methods for dissecting and building filenames. --- /project/slime/cvsroot//slime/slime.el 2006/03/04 20:13:51 1.593 +++ /project/slime/cvsroot//slime/slime.el 2006/03/07 16:59:42 1.594 @@ -1285,7 +1285,7 @@ remote-host username) "Creates a three element list suitable for push'ing onto -slime-filename-translations which uses tramp to load files on +slime-filename-translations which uses Tramp to load files on hostname using username. MACHINE-INSTANCE is a required parameter, REMOTE-HOST defaults to MACHINE-INSTANCE and USERNAME defaults to (user-login-name). @@ -1294,23 +1294,20 @@ which is just the value returned by cl:machine-instance on the remote lisp. REMOTE-HOST is the fully qualified domain name (or just the IP) of the remote machine. USERNAME is the username we -sholud login with." - (setf remote-host (or remote-host machine-instance) - username (or username (user-login-name))) - (lexical-let ((tramp-prefix (concat "/ssh:" username "@" remote-host ":"))) +should login with. +The functions created here expect your tramp-default-method or + tramp-default-method-alist to be setup correctly." + (lexical-let ((remote-host (or remote-host machine-instance)) + (username (or username (user-login-name)))) (list (concat "^" machine-instance "$") - `(lambda (emacs-filename) - (subseq emacs-filename (length ,tramp-prefix))) + (lambda (emacs-filename) + (tramp-file-name-localname + (tramp-dissect-file-name emacs-filename))) `(lambda (lisp-filename) - (concat ,tramp-prefix lisp-filename))))) - -(defun* slime-add-filename-translation (&key machine-instance - remote-host - username) - (push (slime-create-filename-translator :machine-instance machine-instance - :remote-host remote-host - :username username) - slime-filename-translations)) + (tramp-make-tramp-file-name nil + ,username + ,remote-host + lisp-filename))))) ;;;; Starting SLIME From mkoeppe at common-lisp.net Tue Mar 14 04:30:14 2006 From: mkoeppe at common-lisp.net (mkoeppe) Date: Mon, 13 Mar 2006 23:30:14 -0500 (EST) Subject: [slime-cvs] CVS slime Message-ID: <20060314043014.6A9B52E17F@common-lisp.net> Update of /project/slime/cvsroot/slime In directory clnet:/tmp/cvs-serv3644 Modified Files: swank-allegro.lisp Log Message: (compile-from-temp-file): Suppress Allegro's redefinition warnings; they are pointless when we are compiling via a temporary file. (profile-report): Implement. --- /project/slime/cvsroot/slime/swank-allegro.lisp 2006/02/10 16:54:01 1.82 +++ /project/slime/cvsroot/slime/swank-allegro.lisp 2006/03/14 04:30:14 1.83 @@ -306,7 +306,12 @@ (lambda (stream filename) (write-string string stream) (finish-output stream) - (let ((binary-filename (compile-file filename :load-after-compile t))) + (let ((binary-filename + (excl:without-redefinition-warnings + ;; Suppress Allegro's redefinition warnings; they are + ;; pointless when we are compiling via a temporary + ;; file. + (compile-file filename :load-after-compile t)))) (when binary-filename (delete-file binary-filename)))))) @@ -472,6 +477,11 @@ 2) (xref-result result))) +;;;; Profiling + +(defimplementation profile-report () + (prof:show-call-graph)) + ;;;; Inspecting (defclass acl-inspector (inspector) From mkoeppe at common-lisp.net Tue Mar 14 07:41:50 2006 From: mkoeppe at common-lisp.net (mkoeppe) Date: Tue, 14 Mar 2006 02:41:50 -0500 (EST) Subject: [slime-cvs] CVS slime Message-ID: <20060314074150.BDE235E003@common-lisp.net> Update of /project/slime/cvsroot/slime In directory clnet:/tmp/cvs-serv30458 Modified Files: slime.el Log Message: (slime-system-history): New variable. (slime-read-system-name): Use a separate history list for ASDF system names. --- /project/slime/cvsroot/slime/slime.el 2006/03/07 16:59:42 1.594 +++ /project/slime/cvsroot/slime/slime.el 2006/03/14 07:41:50 1.595 @@ -4330,6 +4330,9 @@ (interactive (list (slime-read-system-name))) (slime-oos system "LOAD-OP")) +(defvar slime-system-history nil + "History list for ASDF system names.") + (defun slime-read-system-name (&optional prompt initial-value) "Read a system name from the minibuffer, prompting with PROMPT." (setq prompt (or prompt "System: ")) @@ -4339,7 +4342,8 @@ (slime-eval `(swank:list-all-systems-in-central-registry)))))) (completing-read prompt alist nil nil - (or initial-value (slime-find-asd) "")))) + (or initial-value (slime-find-asd) "") + 'slime-system-history))) (defun slime-oos (system operation &rest keyword-args) (slime-save-some-lisp-buffers) From mkoeppe at common-lisp.net Tue Mar 14 07:43:37 2006 From: mkoeppe at common-lisp.net (mkoeppe) Date: Tue, 14 Mar 2006 02:43:37 -0500 (EST) Subject: [slime-cvs] CVS slime Message-ID: <20060314074337.9809964103@common-lisp.net> Update of /project/slime/cvsroot/slime In directory clnet:/tmp/cvs-serv30615 Modified Files: ChangeLog Log Message: --- /project/slime/cvsroot/slime/ChangeLog 2006/03/07 09:50:25 1.853 +++ /project/slime/cvsroot/slime/ChangeLog 2006/03/14 07:43:36 1.854 @@ -1,7 +1,18 @@ +2006-03-14 Matthias Koeppe + + * slime.el (slime-system-history): New variable. + (slime-read-system-name): Use a separate history list for ASDF + system names. + + * swank-allegro.lisp (compile-from-temp-file): Suppress Allegro's + redefinition warnings; they are pointless when we are compiling + via a temporary file. + (profile-report): Implement. + 2006-03-06 Nathan Bird - * slime.el: (slime-create-filename-translator): use the tramp - methods for dissecting and building filenames. + * slime.el (slime-create-filename-translator): use the tramp + methods for dissecting and building filenames. 2006-03-04 Wojciech Kaczmarek From mkoeppe at common-lisp.net Tue Mar 14 20:36:27 2006 From: mkoeppe at common-lisp.net (mkoeppe) Date: Tue, 14 Mar 2006 15:36:27 -0500 (EST) Subject: [slime-cvs] CVS slime Message-ID: <20060314203627.03B136F242@common-lisp.net> Update of /project/slime/cvsroot/slime In directory clnet:/tmp/cvs-serv6139 Modified Files: slime.el Log Message: (slime-note-counts-message): New variable. (slime-show-note-counts): Store the note counts message for later use. (slime-highlight-notes, slime-list-compiler-notes): Show a progress message, keeping note counts visible. --- /project/slime/cvsroot/slime/slime.el 2006/03/14 07:41:50 1.595 +++ /project/slime/cvsroot/slime/slime.el 2006/03/14 20:36:27 1.596 @@ -4382,6 +4382,9 @@ "") (t (format "%2d %s%s " count severity (if (= count 1) "" "s"))))) +(defvar slime-note-counts-message "" + "A string that contains a summary of the compilation notes.") + (defun slime-show-note-counts (notes &optional secs) (let ((nerrors 0) (nwarnings 0) (nstyle-warnings 0) (nnotes 0)) (dolist (note notes) @@ -4390,14 +4393,15 @@ (:warning (incf nwarnings)) (:style-warning (incf nstyle-warnings)) (:note (incf nnotes)))) - (message - "Compilation finished:%s%s%s%s%s" - (slime-note-count-string "error" nerrors) - (slime-note-count-string "warning" nwarnings) - (slime-note-count-string "style-warning" nstyle-warnings - slime-hide-style-warning-count-if-zero) - (slime-note-count-string "note" nnotes) - (if secs (format "[%s secs]" secs) "")))) + (setq slime-note-counts-message + (format "Compilation finished:%s%s%s%s%s" + (slime-note-count-string "error" nerrors) + (slime-note-count-string "warning" nwarnings) + (slime-note-count-string "style-warning" nstyle-warnings + slime-hide-style-warning-count-if-zero) + (slime-note-count-string "note" nnotes) + (if secs (format "[%s secs]" secs) ""))) + (message "%s" slime-note-counts-message))) (defun slime-xrefs-for-notes (notes) (let ((xrefs)) @@ -4449,9 +4453,11 @@ (defun slime-highlight-notes (notes) "Highlight compiler notes, warnings, and errors in the buffer." (interactive (list (slime-compiler-notes))) + (message "%s. Highlighting notes..." slime-note-counts-message) (save-excursion (slime-remove-old-overlays) - (mapc #'slime-overlay-note (slime-merge-notes-for-display notes)))) + (mapc #'slime-overlay-note (slime-merge-notes-for-display notes))) + (message "%s. Highlighting notes...done." slime-note-counts-message)) (defun slime-compiler-notes () "Return all compiler notes, warnings, and errors." @@ -4546,6 +4552,8 @@ (defun slime-list-compiler-notes (&optional notes) "Show the compiler notes NOTES in tree view." (interactive) + (message "%s. Preparing compiler note tree..." + slime-note-counts-message) (let ((notes (or notes (slime-compiler-notes)))) (with-current-buffer (slime-get-temp-buffer-create "*compiler notes*" @@ -4558,7 +4566,8 @@ (slime-tree-insert tree "") (insert "\n"))) (setq buffer-read-only t) - (goto-char (point-min))))) + (goto-char (point-min)))) + (message "%s" slime-note-counts-message)) (defun slime-alistify (list key test) "Partition the elements of LIST into an alist. KEY extracts the key From mkoeppe at common-lisp.net Tue Mar 14 20:37:26 2006 From: mkoeppe at common-lisp.net (mkoeppe) Date: Tue, 14 Mar 2006 15:37:26 -0500 (EST) Subject: [slime-cvs] CVS slime Message-ID: <20060314203726.860B47061@common-lisp.net> Update of /project/slime/cvsroot/slime In directory clnet:/tmp/cvs-serv6186 Modified Files: ChangeLog Log Message: *** empty log message *** --- /project/slime/cvsroot/slime/ChangeLog 2006/03/14 07:43:36 1.854 +++ /project/slime/cvsroot/slime/ChangeLog 2006/03/14 20:37:26 1.855 @@ -3,6 +3,10 @@ * slime.el (slime-system-history): New variable. (slime-read-system-name): Use a separate history list for ASDF system names. + (slime-note-counts-message): New variable. + (slime-show-note-counts): Store the note counts message for later use. + (slime-highlight-notes, slime-list-compiler-notes): Show a + progress message, keeping note counts visible. * swank-allegro.lisp (compile-from-temp-file): Suppress Allegro's redefinition warnings; they are pointless when we are compiling From mkoeppe at common-lisp.net Tue Mar 14 20:45:16 2006 From: mkoeppe at common-lisp.net (mkoeppe) Date: Tue, 14 Mar 2006 15:45:16 -0500 (EST) Subject: [slime-cvs] CVS slime Message-ID: <20060314204516.6898FA0E5@common-lisp.net> Update of /project/slime/cvsroot/slime In directory clnet:/tmp/cvs-serv7469 Modified Files: ChangeLog Log Message: *** empty log message *** --- /project/slime/cvsroot/slime/ChangeLog 2006/03/14 20:37:26 1.855 +++ /project/slime/cvsroot/slime/ChangeLog 2006/03/14 20:45:16 1.856 @@ -7,6 +7,8 @@ (slime-show-note-counts): Store the note counts message for later use. (slime-highlight-notes, slime-list-compiler-notes): Show a progress message, keeping note counts visible. + (slime-find-buffer-package): Handle IN-PACKAGE forms that appear + in SWIG/Allegro CL wrappers. * swank-allegro.lisp (compile-from-temp-file): Suppress Allegro's redefinition warnings; they are pointless when we are compiling From mbaringer at common-lisp.net Thu Mar 16 12:51:08 2006 From: mbaringer at common-lisp.net (mbaringer) Date: Thu, 16 Mar 2006 07:51:08 -0500 (EST) Subject: [slime-cvs] CVS /slime Message-ID: <20060316125108.D220477000@common-lisp.net> Update of /project/slime/cvsroot//slime In directory clnet:/tmp/cvs-serv12235 Modified Files: slime.el Log Message: (slime-to-lisp-filename): Call expand-file-name before passing the filename to the to-lisp function. --- /project/slime/cvsroot//slime/slime.el 2006/03/14 20:36:27 1.596 +++ /project/slime/cvsroot//slime/slime.el 2006/03/16 12:51:08 1.597 @@ -1260,7 +1260,7 @@ (let ((hostname-regexp (car translation-spec)) (to-lisp (second translation-spec))) (when (string-match hostname-regexp (slime-machine-instance)) - (return-from slime-to-lisp-filename (funcall to-lisp filename))))) + (return-from slime-to-lisp-filename (funcall to-lisp (expand-file-name filename)))))) (error "No elements in slime-filename-translations (%S) matched the connection's hostname (%S)" slime-filename-translations (slime-machine-instance))) From mbaringer at common-lisp.net Thu Mar 16 12:51:53 2006 From: mbaringer at common-lisp.net (mbaringer) Date: Thu, 16 Mar 2006 07:51:53 -0500 (EST) Subject: [slime-cvs] CVS /slime Message-ID: <20060316125153.019777A001@common-lisp.net> Update of /project/slime/cvsroot//slime In directory clnet:/tmp/cvs-serv12276 Modified Files: ChangeLog Log Message: --- /project/slime/cvsroot//slime/ChangeLog 2006/03/14 20:45:16 1.856 +++ /project/slime/cvsroot//slime/ChangeLog 2006/03/16 12:51:53 1.857 @@ -1,3 +1,8 @@ +2006-03-16 Marco Baringer + + * slime.el (slime-to-lisp-filename): Call expand-file-name before + passing the filename to the to-lisp function. + 2006-03-14 Matthias Koeppe * slime.el (slime-system-history): New variable. From mbaringer at common-lisp.net Thu Mar 16 17:25:41 2006 From: mbaringer at common-lisp.net (mbaringer) Date: Thu, 16 Mar 2006 12:25:41 -0500 (EST) Subject: [slime-cvs] CVS /slime Message-ID: <20060316172541.8870550003@common-lisp.net> Update of /project/slime/cvsroot//slime In directory clnet:/tmp/cvs-serv18116 Modified Files: ChangeLog Log Message: --- /project/slime/cvsroot//slime/ChangeLog 2006/03/16 12:51:53 1.857 +++ /project/slime/cvsroot//slime/ChangeLog 2006/03/16 17:25:41 1.858 @@ -1,4 +1,10 @@ -2006-03-16 Marco Baringer +2006-03-16 Gary King + + * swank-loader.lisp (lisp-version-string): Modified swank-loader + so that Allegro's alisp and mlisp programs get different + locations. Otherwise mlisp complains about alisp's files. + +2006-03-16 Marco Baringer * slime.el (slime-to-lisp-filename): Call expand-file-name before passing the filename to the to-lisp function. From mbaringer at common-lisp.net Thu Mar 16 17:26:27 2006 From: mbaringer at common-lisp.net (mbaringer) Date: Thu, 16 Mar 2006 12:26:27 -0500 (EST) Subject: [slime-cvs] CVS /slime Message-ID: <20060316172627.6761A50003@common-lisp.net> Update of /project/slime/cvsroot//slime In directory clnet:/tmp/cvs-serv18167 Modified Files: swank-loader.lisp Log Message: (lisp-version-string): Modified swank-loader so that Allegro's alisp and mlisp programs get different locations. Otherwise mlisp complains about alisp's files. --- /project/slime/cvsroot//slime/swank-loader.lisp 2006/02/25 14:57:21 1.57 +++ /project/slime/cvsroot//slime/swank-loader.lisp 2006/03/16 17:26:27 1.58 @@ -70,7 +70,8 @@ ccl::*openmcl-major-version* ccl::*openmcl-minor-version*) #+lispworks (lisp-implementation-version) - #+allegro excl::*common-lisp-version-number* + #+allegro (concatenate 'string (if (eq 'h 'H) "A" "M") ; ANSI vs MoDeRn + excl::*common-lisp-version-number*) #+clisp (let ((s (lisp-implementation-version))) (subseq s 0 (position #\space s))) #+armedbear (lisp-implementation-version) From mbaringer at common-lisp.net Thu Mar 16 18:33:25 2006 From: mbaringer at common-lisp.net (mbaringer) Date: Thu, 16 Mar 2006 13:33:25 -0500 (EST) Subject: [slime-cvs] CVS /slime Message-ID: <20060316183325.925BE52001@common-lisp.net> Update of /project/slime/cvsroot//slime In directory clnet:/tmp/cvs-serv28693 Modified Files: ChangeLog Log Message: --- /project/slime/cvsroot//slime/ChangeLog 2006/03/16 17:25:41 1.858 +++ /project/slime/cvsroot//slime/ChangeLog 2006/03/16 18:33:25 1.859 @@ -1,3 +1,7 @@ +2006-03-16 G?bor Melis + + * swank-allegro.lisp (inspect-for-emacs): Fix typo. + 2006-03-16 Gary King * swank-loader.lisp (lisp-version-string): Modified swank-loader From mbaringer at common-lisp.net Thu Mar 16 18:34:17 2006 From: mbaringer at common-lisp.net (mbaringer) Date: Thu, 16 Mar 2006 13:34:17 -0500 (EST) Subject: [slime-cvs] CVS /slime Message-ID: <20060316183417.EBA3C54060@common-lisp.net> Update of /project/slime/cvsroot//slime In directory clnet:/tmp/cvs-serv28743 Modified Files: swank-allegro.lisp Log Message: (inspect-for-emacs): Fix typo. --- /project/slime/cvsroot//slime/swank-allegro.lisp 2006/03/14 04:30:14 1.83 +++ /project/slime/cvsroot//slime/swank-allegro.lisp 2006/03/16 18:34:17 1.84 @@ -510,7 +510,7 @@ (defmethod inspect-for-emacs ((o standard-object) (inspector acl-inspector)) inspector - (values (format "~A is a standard-object." o) (allegro-inspect o))) + (values (format nil "~A is a standard-object." o) (allegro-inspect o))) (defun allegro-inspect (o) (loop for (d dd) on (inspect::inspect-ctl o) From mkoeppe at common-lisp.net Sat Mar 18 07:37:22 2006 From: mkoeppe at common-lisp.net (mkoeppe) Date: Sat, 18 Mar 2006 02:37:22 -0500 (EST) Subject: [slime-cvs] CVS slime Message-ID: <20060318073722.3ED323A003@common-lisp.net> Update of /project/slime/cvsroot/slime In directory clnet:/tmp/cvs-serv19558 Modified Files: swank.lisp Log Message: (arglist-for-echo-area): Add keyword argument print-right-margin. (arglist-to-string, format-arglist-for-echo-area): Likewise. --- /project/slime/cvsroot/slime/swank.lisp 2006/02/25 12:10:33 1.363 +++ /project/slime/cvsroot/slime/swank.lisp 2006/03/18 07:37:22 1.364 @@ -1328,7 +1328,7 @@ ;;;; Arglists -(defslimefun arglist-for-echo-area (names) +(defslimefun arglist-for-echo-area (names &key print-right-margin) "Return the arglist for the first function, macro, or special-op in NAMES." (handler-case (with-buffer-syntax () @@ -1339,7 +1339,10 @@ (when name (multiple-value-bind (form operator-name) (operator-designator-to-form name) - (format-arglist-for-echo-area form operator-name))))) + (let ((*print-right-margin* print-right-margin)) + (format-arglist-for-echo-area form operator-name + :print-right-margin + print-right-margin)))))) (error (cond) (format nil "ARGLIST: ~A" cond)))) @@ -1366,7 +1369,7 @@ '()) (t (cons (car arglist) (clean-arglist (cdr arglist)))))) -(defun arglist-to-string (arglist package) +(defun arglist-to-string (arglist package &key print-right-margin) "Print the list ARGLIST for display in the echo area. The argument name are printed without package qualifiers and pretty printing of (function foo) as #'foo is suppressed." @@ -1378,7 +1381,8 @@ (with-standard-io-syntax (let ((*package* package) (*print-case* :downcase) (*print-pretty* t) (*print-circle* nil) (*print-readably* nil) - (*print-level* 10) (*print-length* 20)) + (*print-level* 10) (*print-length* 20) + (*print-right-margin* print-right-margin)) (pprint-logical-block (nil nil :prefix "(" :suffix ")") (loop (let ((arg (pop arglist))) @@ -1831,7 +1835,8 @@ :prefix "")))))) :not-available)) -(defun format-arglist-for-echo-area (form &optional (operator-name (first form))) +(defun format-arglist-for-echo-area (form operator-name + &key print-right-margin) "Return the arglist for FORM as a string." (when (consp form) (let ((operator-form (first form)) @@ -1853,13 +1858,15 @@ (list (return-from format-arglist-for-echo-area (arglist-to-string (cons operator-name arglist) - *package*)))))) + *package* + :print-right-margin print-right-margin)))))) (t (return-from format-arglist-for-echo-area (arglist-to-string (cons operator-name (encode-arglist form-completion)) - *package*))))))) + *package* + :print-right-margin print-right-margin))))))) nil) (defslimefun completions-for-keyword (name keyword-string) From mkoeppe at common-lisp.net Sat Mar 18 07:43:37 2006 From: mkoeppe at common-lisp.net (mkoeppe) Date: Sat, 18 Mar 2006 02:43:37 -0500 (EST) Subject: [slime-cvs] CVS slime Message-ID: <20060318074337.719857E021@common-lisp.net> Update of /project/slime/cvsroot/slime In directory clnet:/tmp/cvs-serv19752 Modified Files: slime.el Log Message: (slime-goto-location-buffer): Avoid calling the expensive function find-file-noselect when we are already in the right buffer. (slime-autodoc): Use :print-right-margin here to make use of the whole width of the echo area for arglist display. --- /project/slime/cvsroot/slime/slime.el 2006/03/16 12:51:08 1.597 +++ /project/slime/cvsroot/slime/slime.el 2006/03/18 07:43:37 1.598 @@ -2351,8 +2351,14 @@ (re-search-forward regexp nil t))) (goto-char (match-end 0)) (skip-chars-forward " \n\t\f\r#'") - (let ((pkg (ignore-errors (read (current-buffer))))) - (if pkg (format "%S" pkg))))))) + (cond + ((looking-at "\\.\\*swig-module-name\\*") ; # was skipped + (if (re-search-backward "(defparameter \\*swig-module-name\\* \\(:?\\sw*\\))" + nil t) + (match-string-no-properties 1))) + (t + (let ((pkg (ignore-errors (read (current-buffer))))) + (if pkg (format "%S" pkg))))))))) ;;; Synchronous requests are implemented in terms of asynchronous ;;; ones. We make an asynchronous request with a continuation function @@ -4926,7 +4932,10 @@ (defun slime-goto-location-buffer (buffer) (destructure-case buffer ((:file filename) - (set-buffer (find-file-noselect (slime-from-lisp-filename filename) t)) + (let ((emacs-filename (slime-from-lisp-filename filename))) + (unless (and (buffer-file-name) + (string= (buffer-file-name) emacs-filename)) + (set-buffer (find-file-noselect emacs-filename t)))) (goto-char (point-min))) ((:buffer buffer) (set-buffer buffer) @@ -5360,7 +5369,10 @@ (slime-eval-async (if (slime-global-variable-name-p name) `(swank:variable-desc-for-echo-area ,name) - `(swank:arglist-for-echo-area '(,name))) + `(swank:arglist-for-echo-area '(,name) + :print-right-margin + ,(window-width + (minibuffer-window)))) (with-lexical-bindings (cache-key name) (lambda (doc) (if (null doc) From mkoeppe at common-lisp.net Sat Mar 18 07:45:18 2006 From: mkoeppe at common-lisp.net (mkoeppe) Date: Sat, 18 Mar 2006 02:45:18 -0500 (EST) Subject: [slime-cvs] CVS slime Message-ID: <20060318074518.B40CE7E022@common-lisp.net> Update of /project/slime/cvsroot/slime In directory clnet:/tmp/cvs-serv21086 Modified Files: ChangeLog Log Message: --- /project/slime/cvsroot/slime/ChangeLog 2006/03/16 18:33:25 1.859 +++ /project/slime/cvsroot/slime/ChangeLog 2006/03/18 07:45:18 1.860 @@ -1,3 +1,15 @@ +2006-03-18 Matthias Koeppe + + * slime.el (slime-goto-location-buffer): Avoid calling the + expensive function find-file-noselect when we are already in the + right buffer. + + * swank.lisp (arglist-for-echo-area): Add keyword argument + print-right-margin. + (arglist-to-string, format-arglist-for-echo-area): Likewise. + * slime.el (slime-autodoc): Use it here to make use of the whole + width of the echo area for arglist display. + 2006-03-16 G?bor Melis * swank-allegro.lisp (inspect-for-emacs): Fix typo. From mkoeppe at common-lisp.net Sun Mar 19 06:38:52 2006 From: mkoeppe at common-lisp.net (mkoeppe) Date: Sun, 19 Mar 2006 01:38:52 -0500 (EST) Subject: [slime-cvs] CVS slime Message-ID: <20060319063852.E387D5C138@common-lisp.net> Update of /project/slime/cvsroot/slime In directory clnet:/tmp/cvs-serv22492 Modified Files: swank.lisp Log Message: (arglist-for-echo-area): New keyword argument arg-indices. (arglist-to-string): New keyword argument highlight. (format-arglist-for-echo-area): Likewise. --- /project/slime/cvsroot/slime/swank.lisp 2006/03/18 07:37:22 1.364 +++ /project/slime/cvsroot/slime/swank.lisp 2006/03/19 06:38:52 1.365 @@ -1328,21 +1328,27 @@ ;;;; Arglists -(defslimefun arglist-for-echo-area (names &key print-right-margin) +(defslimefun arglist-for-echo-area (names &key print-right-margin + arg-indices) "Return the arglist for the first function, macro, or special-op in NAMES." (handler-case (with-buffer-syntax () - (let ((name (find-if (lambda (name) - (or (consp name) - (valid-operator-name-p name))) - names))) - (when name - (multiple-value-bind (form operator-name) - (operator-designator-to-form name) - (let ((*print-right-margin* print-right-margin)) - (format-arglist-for-echo-area form operator-name - :print-right-margin - print-right-margin)))))) + (let ((which (position-if (lambda (name) + (or (consp name) + (valid-operator-name-p name))) + names))) + (when which + (let ((name (elt names which)) + (arg-index (and arg-indices (elt arg-indices which)))) + (multiple-value-bind (form operator-name) + (operator-designator-to-form name) + (let ((*print-right-margin* print-right-margin)) + (format-arglist-for-echo-area + form operator-name + :print-right-margin print-right-margin + :highlight (and (not (zerop arg-index)) + ;; don't highlight the operator + arg-index)))))))) (error (cond) (format nil "ARGLIST: ~A" cond)))) @@ -1369,10 +1375,12 @@ '()) (t (cons (car arglist) (clean-arglist (cdr arglist)))))) -(defun arglist-to-string (arglist package &key print-right-margin) +(defun arglist-to-string (arglist package &key print-right-margin highlight) "Print the list ARGLIST for display in the echo area. The argument name are printed without package qualifiers and -pretty printing of (function foo) as #'foo is suppressed." +pretty printing of (function foo) as #'foo is suppressed. +If HIGHLIGHT is non-nil, it must be the index of an argument; +highlight this argument." (setq arglist (clean-arglist arglist)) (etypecase arglist (null "()") @@ -1383,20 +1391,33 @@ (*print-pretty* t) (*print-circle* nil) (*print-readably* nil) (*print-level* 10) (*print-length* 20) (*print-right-margin* print-right-margin)) - (pprint-logical-block (nil nil :prefix "(" :suffix ")") - (loop - (let ((arg (pop arglist))) - (etypecase arg - (symbol (princ arg)) - (string (princ arg)) - (cons (pprint-logical-block (nil nil :prefix "(" :suffix ")") - (princ (car arg)) - (unless (null (cdr arg)) - (write-char #\space)) - (pprint-fill *standard-output* (cdr arg) nil)))) - (when (null arglist) (return)) - (write-char #\space) - (pprint-newline :fill)))))))))) + (let ((index 0)) + (pprint-logical-block (nil nil :prefix "(" :suffix ")") + (loop + (let ((arg (pop arglist))) + (when (member arg lambda-list-keywords) + ;; The highlighting code is currently only + ;; prepared for the required arguments. To + ;; extend it to work with optional and keyword + ;; arguments as well, arglist-to-string should + ;; get a DECODED-ARGLIST instead. --mkoeppe + (setq highlight nil)) + (when (and highlight (= index highlight)) + (princ "===> ")) + (etypecase arg + (symbol (princ arg)) + (string (princ arg)) + (cons (pprint-logical-block (nil nil :prefix "(" :suffix ")") + (princ (car arg)) + (unless (null (cdr arg)) + (write-char #\space)) + (pprint-fill *standard-output* (cdr arg) nil)))) + (when (and highlight (= index highlight)) + (princ " <===")) + (incf index) + (when (null arglist) (return)) + (write-char #\space) + (pprint-newline :fill))))))))))) (defun test-print-arglist (list string) (string= (arglist-to-string list (find-package :swank)) string)) @@ -1836,7 +1857,7 @@ :not-available)) (defun format-arglist-for-echo-area (form operator-name - &key print-right-margin) + &key print-right-margin highlight) "Return the arglist for FORM as a string." (when (consp form) (let ((operator-form (first form)) @@ -1859,14 +1880,16 @@ (return-from format-arglist-for-echo-area (arglist-to-string (cons operator-name arglist) *package* - :print-right-margin print-right-margin)))))) + :print-right-margin print-right-margin + :highlight highlight)))))) (t (return-from format-arglist-for-echo-area (arglist-to-string (cons operator-name (encode-arglist form-completion)) *package* - :print-right-margin print-right-margin))))))) + :print-right-margin print-right-margin + :highlight highlight))))))) nil) (defslimefun completions-for-keyword (name keyword-string) From mkoeppe at common-lisp.net Sun Mar 19 06:49:52 2006 From: mkoeppe at common-lisp.net (mkoeppe) Date: Sun, 19 Mar 2006 01:49:52 -0500 (EST) Subject: [slime-cvs] CVS slime Message-ID: <20060319064952.DCBDD68120@common-lisp.net> Update of /project/slime/cvsroot/slime In directory clnet:/tmp/cvs-serv23966 Modified Files: slime.el Log Message: (slime-space): First insert the space, then obtain information. (slime-fontify-string): Also handle argument highlights. (slime-enclosing-operator-names): As a secondary value, return a list of the indices of the arguments to the nested operator. (slime-contextual-completions): Use changed interface of slime-enclosing-operator-names. (slime-function-called-at-point): Removed. (slime-function-called-at-point/line): Removed. (slime-autodoc-thing-at-point): New. (slime-autodoc): Re-implement with slime-enclosing-operator-names instead of slime-function-called-at-point. (slime-echo-arglist): Pass the argument indices to arglist-for-echo-area. (slime-autodoc-message-ok-p): Autodoc is also OK in REPL buffers. --- /project/slime/cvsroot/slime/slime.el 2006/03/18 07:43:37 1.598 +++ /project/slime/cvsroot/slime/slime.el 2006/03/19 06:49:52 1.599 @@ -5249,11 +5249,11 @@ Designed to be bound to the SPC key. Prefix argument can be used to insert more than one space." (interactive "p") + (self-insert-command n) (unwind-protect (when (and slime-space-information-p (slime-background-activities-enabled-p)) - (slime-echo-arglist)) - (self-insert-command n))) + (slime-echo-arglist)))) (defun slime-fontify-string (string) "Fontify STRING as `font-lock-mode' does in Lisp mode." @@ -5264,14 +5264,22 @@ (insert string) (let ((font-lock-verbose nil)) (font-lock-fontify-buffer)) + (goto-char (point-min)) + (when (re-search-forward "===> \\(.*\\) <===" nil t) + (let ((highlight (propertize (match-string 1) 'face 'highlight))) + ;; Can't use (replace-match highlight) here -- broken in Emacs 21 + (delete-region (match-beginning 0) (match-end 0)) + (insert highlight))) (buffer-substring (point-min) (point-max)))) (defun slime-echo-arglist () "Display the arglist of the current form in the echo area." - (let ((names (slime-enclosing-operator-names))) + (multiple-value-bind (names arg-indices) + (slime-enclosing-operator-names) (when names (slime-eval-async - `(swank:arglist-for-echo-area (quote ,names)) + `(swank:arglist-for-echo-area (quote ,names) + :arg-indices (quote ,arg-indices)) (lexical-let ((buffer (current-buffer))) (lambda (message) (if message @@ -5357,29 +5365,46 @@ (slime-autodoc-start-timer) (slime-autodoc-stop-timer))) +(defun slime-autodoc-thing-at-point () + "Return a cache key and a swank form." + (let ((global (slime-autodoc-global-at-point))) + (if global + (values (slime-qualify-cl-symbol-name global) + `(swank:variable-desc-for-echo-area ,global)) + (multiple-value-bind (operators arg-indices) + (slime-enclosing-operator-names) + (values (mapcar* (lambda (designator arg-index) + (cons + (if (symbolp designator) + (slime-qualify-cl-symbol-name designator) + designator) + arg-index)) + operators arg-indices) + `(swank:arglist-for-echo-area ',operators + :arg-indices + ',arg-indices + :print-right-margin + ,(window-width + (minibuffer-window)))))))) + (defun slime-autodoc () "Print some apropos information about the code at point, if applicable." - (when-let (name (or (slime-autodoc-global-at-point) - (slime-function-called-at-point/line))) - (let ((cache-key (slime-qualify-cl-symbol-name name))) - (or (when-let (documentation (slime-get-cached-autodoc cache-key)) - (slime-background-message "%s" documentation) - t) - ;; Asynchronously fetch, cache, and display documentation - (slime-eval-async - (if (slime-global-variable-name-p name) - `(swank:variable-desc-for-echo-area ,name) - `(swank:arglist-for-echo-area '(,name) - :print-right-margin - ,(window-width - (minibuffer-window)))) - (with-lexical-bindings (cache-key name) - (lambda (doc) - (if (null doc) - (setq doc "") - (setq doc (slime-fontify-string doc))) - (slime-update-autodoc-cache cache-key doc) - (slime-background-message "%s" doc)))))))) + (multiple-value-bind (cache-key retrieve-form) + (slime-autodoc-thing-at-point) + (unless + (when-let (documentation (slime-get-cached-autodoc cache-key)) + (slime-background-message "%s [cached]" documentation) + t) + ;; Asynchronously fetch, cache, and display documentation + (slime-eval-async + retrieve-form + (with-lexical-bindings (cache-key name) + (lambda (doc) + (if (null doc) + (setq doc "") + (setq doc (slime-fontify-string doc))) + (slime-update-autodoc-cache cache-key doc) + (slime-background-message "%s" doc))))))) (defun slime-autodoc-global-at-point () "Return the global variable name at point, if any." @@ -5452,7 +5477,7 @@ (defun slime-autodoc-message-ok-p () "Return true if printing a message is currently okay (shouldn't annoy the user)." - (and slime-mode + (and (or slime-mode (eq major-mode 'slime-repl-mode)) slime-autodoc-mode (null (current-message)) (not executing-kbd-macro) @@ -5837,7 +5862,8 @@ ;; Contextual keyword completion (let ((operator-names (save-excursion (goto-char beg) - (slime-enclosing-operator-names 1)))) + (nth-value 0 + (slime-enclosing-operator-names 1))))) (when operator-names (let ((completions (slime-completions-for-keyword (first operator-names) token))) @@ -9896,71 +9922,61 @@ (or (slime-sexp-at-point) (error "No expression at point."))) -(defun slime-function-called-at-point/line () - "Return the name of the function being called at point, provided the -function call starts on the same line at the point itself." - (and (ignore-errors - (slime-same-line-p (save-excursion (backward-up-list 1) (point)) - (point))) - (slime-function-called-at-point))) - -(defun slime-function-called-at-point () - "Return a function around point or else called by the list containing point. -Return the symbol-name, or nil." - (ignore-errors - (save-excursion - (save-restriction - (narrow-to-region (max (point-min) (- (point) 1000)) - (point-max)) - ;; Move up to surrounding paren, then after the open. - (backward-up-list 1) - (when (or (ignore-errors - ;; "((foo" is probably not a function call - (save-excursion (backward-up-list 1) - (looking-at "(\\s *("))) - ;; nor is "( foo" - (looking-at "([ \t]")) - (error "Probably not a Lisp function call")) - (forward-char 1) - (slime-symbol-name-at-point))))) - (defun slime-enclosing-operator-names (&optional max-levels) "Return the list of operator names of the forms containing point. -When MAX-LEVELS is non-nil, go up at most this many levels of parens." +As a secondary value, return the indices of the respective argument to +the operator. When MAX-LEVELS is non-nil, go up at most this many +levels of parens." (let ((result '()) + (arg-indices '()) (level 1)) (ignore-errors - (save-restriction - (narrow-to-region (save-excursion (beginning-of-defun) (point)) - (point)) - (save-excursion + (save-excursion + ;; Make sure we get the whole operator name. + (slime-end-of-symbol) + (save-restriction + (narrow-to-region (save-excursion (beginning-of-defun) (point)) + (min (1+ (point)) (point-max))) (while (or (not max-levels) (<= level max-levels)) - (backward-up-list 1) - (when (looking-at "(") - (incf level) - (forward-char 1) - (when-let (name (slime-symbol-name-at-point)) - ;; Detect MAKE-INSTANCE forms and collect the class-name - ;; if exists and is a quoted symbol. - (ignore-errors - (cond - ((member (upcase name) '("MAKE-INSTANCE" - "CL:MAKE-INSTANCE")) - (forward-char (1+ (length name))) - (slime-forward-blanks) - (let ((str (slime-sexp-at-point))) - (when (= (aref str 0) ?') - (setq name (list :make-instance (substring str 1)))))) - ((member (upcase name) '("DEFMETHOD" - "CL:DEFMETHOD")) - (forward-char (1+ (length name))) - (slime-forward-blanks) - (let ((str (slime-sexp-at-point))) - (setq name (list :defmethod str)))))) - (push name result)) - (backward-up-list 1)))))) - (nreverse result))) + (let ((arg-index 0)) + ;; Move to the beginning of the current sexp if not already there. + (if (or (looking-at "[(']") + (= (char-syntax (char-before)) ?\ )) + (incf arg-index)) + (ignore-errors + (backward-sexp 1)) + (while (ignore-errors (backward-sexp 1) + (> (point) (point-min))) + (incf arg-index)) + (backward-up-list 1) + (when (looking-at "(") + (incf level) + (forward-char 1) + (when-let (name (slime-symbol-name-at-point)) + ;; Detect MAKE-INSTANCE forms and collect the class-name + ;; if exists and is a quoted symbol. + (ignore-errors + (cond + ((member (upcase name) '("MAKE-INSTANCE" + "CL:MAKE-INSTANCE")) + (forward-char (1+ (length name))) + (slime-forward-blanks) + (let ((str (slime-sexp-at-point))) + (when (= (aref str 0) ?') + (setq name (list :make-instance (substring str 1)))))) + ((member (upcase name) '("DEFMETHOD" + "CL:DEFMETHOD")) + (forward-char (1+ (length name))) + (slime-forward-blanks) + (let ((str (slime-sexp-at-point))) + (setq name (list :defmethod str)))))) + (push name result) + (push arg-index arg-indices)) + (backward-up-list 1))))))) + (values + (nreverse result) + (nreverse arg-indices)))) ;;;;; Portability library From mkoeppe at common-lisp.net Sun Mar 19 06:51:55 2006 From: mkoeppe at common-lisp.net (mkoeppe) Date: Sun, 19 Mar 2006 01:51:55 -0500 (EST) Subject: [slime-cvs] CVS slime Message-ID: <20060319065155.7C6AE7208D@common-lisp.net> Update of /project/slime/cvsroot/slime In directory clnet:/tmp/cvs-serv24088 Modified Files: ChangeLog Log Message: *** empty log message *** --- /project/slime/cvsroot/slime/ChangeLog 2006/03/18 07:45:18 1.860 +++ /project/slime/cvsroot/slime/ChangeLog 2006/03/19 06:51:55 1.861 @@ -1,3 +1,31 @@ +2006-03-19 Matthias Koeppe + + Highlight the formal argument corresponding to the actual + argument around point in the echo-area arg-list display. + Works most impressively when slime-autodoc-mode is enabled + and when one has to deal with extremely long argument lists. + + * slime.el (slime-space): First insert the space, then obtain + information. + (slime-fontify-string): Also handle argument highlights. + (slime-enclosing-operator-names): As a secondary value, return a + list of the indices of the arguments to the nested operator. + (slime-contextual-completions): Use changed interface of + slime-enclosing-operator-names. + (slime-function-called-at-point): Removed. + (slime-function-called-at-point/line): Removed. + (slime-autodoc-thing-at-point): New. + (slime-autodoc): Re-implement with slime-enclosing-operator-names + instead of slime-function-called-at-point. + (slime-echo-arglist): Pass the argument indices to + arglist-for-echo-area. + (slime-autodoc-message-ok-p): Autodoc is also OK in REPL buffers. + + * swank.lisp (arglist-for-echo-area): New keyword argument + arg-indices. + (arglist-to-string): New keyword argument highlight. + (format-arglist-for-echo-area): Likewise. + 2006-03-18 Matthias Koeppe * slime.el (slime-goto-location-buffer): Avoid calling the From mkoeppe at common-lisp.net Sun Mar 19 23:15:11 2006 From: mkoeppe at common-lisp.net (mkoeppe) Date: Sun, 19 Mar 2006 18:15:11 -0500 (EST) Subject: [slime-cvs] CVS slime Message-ID: <20060319231511.30E007A002@common-lisp.net> Update of /project/slime/cvsroot/slime In directory clnet:/tmp/cvs-serv13244 Modified Files: slime.el Log Message: (slime-autodoc-pre-command-refresh-echo-area): Show the last autodoc message again (movement commands clear it); technique to avoid flickering, taken from eldoc. (slime-autodoc-mode): Install it as a pre-command-hook. (slime-autodoc-last-message): New variable. (slime-autodoc-message): New function. (slime-autodoc): Use them here. (slime-autodoc-message-ok-p): OK to overwrite an autodoc message. (slime-handle-indentation-update): Also update scheme-indent-function if slime-lisp-modes contains scheme-mode. --- /project/slime/cvsroot/slime/slime.el 2006/03/19 06:49:52 1.599 +++ /project/slime/cvsroot/slime/slime.el 2006/03/19 23:15:10 1.600 @@ -5362,9 +5362,42 @@ (arg (setq slime-autodoc-mode t)) (t (setq slime-autodoc-mode (not slime-autodoc-mode)))) (if slime-autodoc-mode - (slime-autodoc-start-timer) + (progn + (slime-autodoc-start-timer) + (add-hook 'pre-command-hook 'slime-autodoc-pre-command-refresh-echo-area t)) (slime-autodoc-stop-timer))) +(defvar slime-autodoc-last-message "") + +(defun slime-autodoc () + "Print some apropos information about the code at point, if applicable." + (multiple-value-bind (cache-key retrieve-form) + (slime-autodoc-thing-at-point) + (unless + (when-let (documentation (slime-get-cached-autodoc cache-key)) + (slime-autodoc-message documentation) + t) + ;; Asynchronously fetch, cache, and display documentation + (slime-eval-async + retrieve-form + (with-lexical-bindings (cache-key name) + (lambda (doc) + (if (null doc) + (setq doc "") + (setq doc (slime-fontify-string doc))) + (slime-update-autodoc-cache cache-key doc) + (slime-autodoc-message doc))))))) + +(defun slime-autodoc-message (doc) + (setq slime-autodoc-last-message doc) + (slime-background-message "%s" doc)) + +(defun slime-autodoc-pre-command-refresh-echo-area () + (unless (string= slime-autodoc-last-message "") + (if (slime-autodoc-message-ok-p) + (slime-background-message "%s" slime-autodoc-last-message) + (setq slime-autodoc-last-message "")))) + (defun slime-autodoc-thing-at-point () "Return a cache key and a swank form." (let ((global (slime-autodoc-global-at-point))) @@ -5387,25 +5420,6 @@ ,(window-width (minibuffer-window)))))))) -(defun slime-autodoc () - "Print some apropos information about the code at point, if applicable." - (multiple-value-bind (cache-key retrieve-form) - (slime-autodoc-thing-at-point) - (unless - (when-let (documentation (slime-get-cached-autodoc cache-key)) - (slime-background-message "%s [cached]" documentation) - t) - ;; Asynchronously fetch, cache, and display documentation - (slime-eval-async - retrieve-form - (with-lexical-bindings (cache-key name) - (lambda (doc) - (if (null doc) - (setq doc "") - (setq doc (slime-fontify-string doc))) - (slime-update-autodoc-cache cache-key doc) - (slime-background-message "%s" doc))))))) - (defun slime-autodoc-global-at-point () "Return the global variable name at point, if any." (when-let (name (slime-symbol-name-at-point)) @@ -5479,7 +5493,8 @@ annoy the user)." (and (or slime-mode (eq major-mode 'slime-repl-mode)) slime-autodoc-mode - (null (current-message)) + (or (null (current-message)) + (string= (current-message) slime-autodoc-last-message)) (not executing-kbd-macro) (not (and (boundp 'edebug-active) (symbol-value 'edebug-active))) (not cursor-in-echo-area) @@ -9063,11 +9078,17 @@ (string-match "^\\(def\\|\\with-\\)" symbol-name)) (let ((symbol (intern symbol-name)) (indent (cdr info))) - ;; Does the symbol have an indentation value that we set? - (when (equal (get symbol 'common-lisp-indent-function) - (get symbol 'slime-indent)) - (put symbol 'slime-indent indent) - (put symbol 'common-lisp-indent-function indent))))))) + (let ((old-slime-indent (get symbol 'slime-indent))) + (flet ((update (indent-function) + ;; Does the symbol have an indentation value + ;; that we set? + (when (equal (get symbol indent-function) + old-slime-indent) + (put symbol 'slime-indent indent) + (put symbol indent-function indent)))) + (update 'common-lisp-indent-function) + (when (member 'scheme-mode slime-lisp-modes) + (update 'scheme-indent-function))))))))) (defun slime-reindent-defun (&optional force-text-fill) "Reindent the current defun, or refill the current paragraph. From mkoeppe at common-lisp.net Sun Mar 19 23:15:54 2006 From: mkoeppe at common-lisp.net (mkoeppe) Date: Sun, 19 Mar 2006 18:15:54 -0500 (EST) Subject: [slime-cvs] CVS slime Message-ID: <20060319231554.53A66111C8@common-lisp.net> Update of /project/slime/cvsroot/slime In directory clnet:/tmp/cvs-serv13442 Modified Files: ChangeLog Log Message: *** empty log message *** --- /project/slime/cvsroot/slime/ChangeLog 2006/03/19 06:51:55 1.861 +++ /project/slime/cvsroot/slime/ChangeLog 2006/03/19 23:15:53 1.862 @@ -1,3 +1,17 @@ +2006-03-20 Matthias Koeppe + + * slime.el (slime-autodoc-pre-command-refresh-echo-area): + Show the last autodoc message again (movement commands clear it); + technique to avoid flickering, taken from eldoc. + (slime-autodoc-mode): Install it as a pre-command-hook. + (slime-autodoc-last-message): New variable. + (slime-autodoc-message): New function. + (slime-autodoc): Use them here. + (slime-autodoc-message-ok-p): OK to overwrite an autodoc message. + + * slime.el (slime-handle-indentation-update): Also update + scheme-indent-function if slime-lisp-modes contains scheme-mode. + 2006-03-19 Matthias Koeppe Highlight the formal argument corresponding to the actual From mkoeppe at common-lisp.net Wed Mar 22 02:46:46 2006 From: mkoeppe at common-lisp.net (mkoeppe) Date: Tue, 21 Mar 2006 21:46:46 -0500 (EST) Subject: [slime-cvs] CVS slime Message-ID: <20060322024646.0AD9E650B0@common-lisp.net> Update of /project/slime/cvsroot/slime In directory clnet:/tmp/cvs-serv17971 Modified Files: swank.lisp Log Message: (inspect-for-emacs): Specialize on FILE-STREAM and STREAM-ERROR, offering to visit the file at the current stream position as an inspector action. Useful for dealing with reader errors. --- /project/slime/cvsroot/slime/swank.lisp 2006/03/19 06:38:52 1.365 +++ /project/slime/cvsroot/slime/swank.lisp 2006/03/22 02:46:45 1.366 @@ -4134,6 +4134,43 @@ (label-value-line "Digits" (float-digits f)) (label-value-line "Precision" (float-precision f)))))) +(defmethod inspect-for-emacs ((stream file-stream) inspector) + (declare (ignore inspector)) + (multiple-value-bind (title content) + (call-next-method) + (declare (ignore title)) + (values "A file stream." + (append + `("Pathname: " + (:value ,(pathname stream)) + (:newline) " " + (:action "[visit file and show current position]" + ,(let ((pathname (pathname stream)) + (position (file-position stream))) + (lambda () + (ed-in-emacs `(,pathname :charpos ,position))))) + (:newline)) + content)))) + +(defmethod inspect-for-emacs ((condition stream-error) inspector) + (declare (ignore inspector)) + (multiple-value-bind (title content) + (call-next-method) + (declare (ignore title)) + (let ((stream (stream-error-stream condition))) + (values "A stream error." + (append + `("Pathname: " + (:value ,(pathname stream)) + (:newline) " " + (:action "[visit file and show current position]" + ,(let ((pathname (pathname stream)) + (position (file-position stream))) + (lambda () + (ed-in-emacs `(,pathname :charpos ,position))))) + (:newline)) + content))))) + (defvar *inspectee*) (defvar *inspectee-parts*) (defvar *inspectee-actions*) From mkoeppe at common-lisp.net Wed Mar 22 02:48:26 2006 From: mkoeppe at common-lisp.net (mkoeppe) Date: Tue, 21 Mar 2006 21:48:26 -0500 (EST) Subject: [slime-cvs] CVS slime Message-ID: <20060322024826.9CC3867164@common-lisp.net> Update of /project/slime/cvsroot/slime In directory clnet:/tmp/cvs-serv18017 Modified Files: slime.el Log Message: (slime-ed): Handle (FILENAME :charpos CHARPOS). --- /project/slime/cvsroot/slime/slime.el 2006/03/19 23:15:10 1.600 +++ /project/slime/cvsroot/slime/slime.el 2006/03/22 02:48:26 1.601 @@ -6411,10 +6411,11 @@ WHAT can be: A filename (string), A list (FILENAME LINE [COLUMN]), + A list (FILENAME :charpos CHARPOS), A function name (symbol), nil. -This for use in the implementation of COMMON-LISP:ED." +This is for use in the implementation of COMMON-LISP:ED." ;; Without `save-excursion' very strange things happen if you call ;; (swank:ed-in-emacs X) from the REPL. -luke (18/Jan/2004) (save-excursion @@ -6426,14 +6427,18 @@ (find-file (slime-from-lisp-filename what))) ((consp what) (find-file (first (slime-from-lisp-filename what))) - (goto-line (second what)) - ;; Find the correct column, without going past the end of - ;; the line. - (let ((col (third what))) - (while (and col - (< (point) (point-at-eol)) - (/= (decf col) -1)) - (forward-char 1)))) + (cond + ((eql (second what) :charpos) + (goto-char (third what))) + (t + (goto-line (second what)) + ;; Find the correct column, without going past the end of + ;; the line. + (let ((col (third what))) + (while (and col + (< (point) (point-at-eol)) + (/= (decf col) -1)) + (forward-char 1)))))) ((and what (symbolp what)) (slime-edit-definition (symbol-name what))) (t nil)))) ; nothing in particular From mkoeppe at common-lisp.net Wed Mar 22 02:48:38 2006 From: mkoeppe at common-lisp.net (mkoeppe) Date: Tue, 21 Mar 2006 21:48:38 -0500 (EST) Subject: [slime-cvs] CVS slime Message-ID: <20060322024838.2FD0368121@common-lisp.net> Update of /project/slime/cvsroot/slime In directory clnet:/tmp/cvs-serv18043 Modified Files: ChangeLog Log Message: *** empty log message *** --- /project/slime/cvsroot/slime/ChangeLog 2006/03/19 23:15:53 1.862 +++ /project/slime/cvsroot/slime/ChangeLog 2006/03/22 02:48:38 1.863 @@ -1,3 +1,12 @@ +2006-03-22 Matthias Koeppe + + * slime.el (slime-ed): Handle (FILENAME :charpos CHARPOS). + + * swank.lisp (inspect-for-emacs): Specialize on FILE-STREAM and + STREAM-ERROR, offering to visit the file at the current stream + position as an inspector action. Useful for dealing with reader + errors. + 2006-03-20 Matthias Koeppe * slime.el (slime-autodoc-pre-command-refresh-echo-area): From mkoeppe at common-lisp.net Wed Mar 22 06:06:18 2006 From: mkoeppe at common-lisp.net (mkoeppe) Date: Wed, 22 Mar 2006 01:06:18 -0500 (EST) Subject: [slime-cvs] CVS slime Message-ID: <20060322060618.E74B170217@common-lisp.net> Update of /project/slime/cvsroot/slime In directory clnet:/tmp/cvs-serv10763 Modified Files: swank.lisp Log Message: (inspect-for-emacs stream-error t): Don't call pathname on non-file streams. --- /project/slime/cvsroot/slime/swank.lisp 2006/03/22 02:46:45 1.366 +++ /project/slime/cvsroot/slime/swank.lisp 2006/03/22 06:06:18 1.367 @@ -4156,20 +4156,21 @@ (declare (ignore inspector)) (multiple-value-bind (title content) (call-next-method) - (declare (ignore title)) (let ((stream (stream-error-stream condition))) - (values "A stream error." - (append - `("Pathname: " - (:value ,(pathname stream)) - (:newline) " " - (:action "[visit file and show current position]" - ,(let ((pathname (pathname stream)) - (position (file-position stream))) - (lambda () - (ed-in-emacs `(,pathname :charpos ,position))))) - (:newline)) - content))))) + (if (typep stream 'file-stream) + (values "A stream error." + (append + `("Pathname: " + (:value ,(pathname stream)) + (:newline) " " + (:action "[visit file and show current position]" + ,(let ((pathname (pathname stream)) + (position (file-position stream))) + (lambda () + (ed-in-emacs `(,pathname :charpos ,position))))) + (:newline)) + content)) + (values title content))))) (defvar *inspectee*) (defvar *inspectee-parts*) From dcrosher at common-lisp.net Wed Mar 22 16:40:01 2006 From: dcrosher at common-lisp.net (dcrosher) Date: Wed, 22 Mar 2006 11:40:01 -0500 (EST) Subject: [slime-cvs] CVS slime Message-ID: <20060322164001.B3F5C4707C@common-lisp.net> Update of /project/slime/cvsroot/slime In directory clnet:/tmp/cvs-serv26977 Modified Files: ChangeLog swank-allegro.lisp swank-backend.lisp swank-clisp.lisp swank-cmucl.lisp swank-corman.lisp swank-ecl.lisp swank-lispworks.lisp swank-openmcl.lisp swank-sbcl.lisp swank-scl.lisp swank.lisp Log Message: * Improve the robustness of connection establishment. --- /project/slime/cvsroot/slime/ChangeLog 2006/03/22 02:48:38 1.863 +++ /project/slime/cvsroot/slime/ChangeLog 2006/03/22 16:40:01 1.864 @@ -1,3 +1,30 @@ +2006-03-23 Douglas Crosher + + * swank-backend (accept-connection): add a 'timeout argument to + this function. + + * swank-backend (set-stream-timeout): new implementation specific + function. Used to set the timeout for stream operations, which + can help make the network connection establishment more robust. + + * swank (setup-server): ignore errors from the function 'serve to + allow another connection to be made. + + * swank (serve-connection): ensure the listener socket is closed + when 'dont-close is false, even if the connection attempt fails. + + * swank (accept-authenticated-connection): ensure the new + connection is closed if the connection establishment fails. Set a + short stream timeout to prevent denial of survice. + + * swank (open-dedicated-output-stream): ensure the listener socket + is closed, even if unable to open the dedicated stream. Implement + a timeout while waiting for a connection for the dedicate stream + to prevent denial of service. + + * swank (create-connection): ensure the new connection is closed + if not successful. + 2006-03-22 Matthias Koeppe * slime.el (slime-ed): Handle (FILENAME :charpos CHARPOS). --- /project/slime/cvsroot/slime/swank-allegro.lisp 2006/03/16 18:34:17 1.84 +++ /project/slime/cvsroot/slime/swank-allegro.lisp 2006/03/22 16:40:01 1.85 @@ -41,8 +41,9 @@ (defimplementation close-socket (socket) (close socket)) -(defimplementation accept-connection (socket &key external-format buffering) - (declare (ignore buffering)) +(defimplementation accept-connection (socket &key external-format buffering + timeout) + (declare (ignore buffering timeout)) (let ((ef (or external-format :iso-latin-1-unix)) (s (socket:accept-connection socket :wait t))) (set-external-format s ef) --- /project/slime/cvsroot/slime/swank-backend.lisp 2006/02/25 12:10:33 1.96 +++ /project/slime/cvsroot/slime/swank-backend.lisp 2006/03/22 16:40:01 1.97 @@ -214,7 +214,7 @@ "Close the socket SOCKET.") (definterface accept-connection (socket &key external-format - buffering) + buffering timeout) "Accept a client connection on the listening socket SOCKET. Return a stream for the new connection.") @@ -234,6 +234,12 @@ "Return one of the symbols :spawn, :sigio, :fd-handler, or NIL." nil) +(definterface set-stream-timeout (stream timeout) + "Set the 'stream 'timeout. The timeout is either the real number + specifying the timeout in seconds or 'nil for no timeout." + (declare (ignore stream timeout)) + nil) + ;;; Base condition for networking errors. (define-condition network-error (simple-error) ()) --- /project/slime/cvsroot/slime/swank-clisp.lisp 2005/11/11 23:43:43 1.57 +++ /project/slime/cvsroot/slime/swank-clisp.lisp 2006/03/22 16:40:01 1.58 @@ -126,8 +126,8 @@ (defimplementation accept-connection (socket &key (external-format :iso-latin-1-unix) - buffering) - (declare (ignore buffering)) + buffering timeout) + (declare (ignore buffering timeout)) (socket:socket-accept socket :buffered nil ;; XXX should be t :element-type 'character --- /project/slime/cvsroot/slime/swank-cmucl.lisp 2005/11/22 10:32:37 1.159 +++ /project/slime/cvsroot/slime/swank-cmucl.lisp 2006/03/22 16:40:01 1.160 @@ -100,7 +100,9 @@ (defimplementation accept-connection (socket &key (external-format :iso-latin-1-unix) - (buffering :full)) + (buffering :full) + timeout) + (declare (ignore timeout)) (unless (eq external-format ':iso-latin-1-unix) (remove-fd-handlers socket) (remove-sigio-handlers socket) --- /project/slime/cvsroot/slime/swank-corman.lisp 2005/11/11 23:43:43 1.5 +++ /project/slime/cvsroot/slime/swank-corman.lisp 2006/03/22 16:40:01 1.6 @@ -239,8 +239,8 @@ (defimplementation accept-connection (socket &key (external-format :iso-latin-1-unix) - buffering) - (declare (ignore buffering)) + buffering timeout) + (declare (ignore buffering timeout)) (ecase external-format (:iso-latin-1-unix (sockets:make-socket-stream (sockets:accept-socket socket))))) --- /project/slime/cvsroot/slime/swank-ecl.lisp 2005/11/11 23:43:43 1.4 +++ /project/slime/cvsroot/slime/swank-ecl.lisp 2006/03/22 16:40:01 1.5 @@ -46,8 +46,8 @@ (defimplementation accept-connection (socket &key (external-format :iso-latin-1-unix) - buffering) - (declare (ignore buffering)) + buffering timeout) + (declare (ignore buffering timeout)) (assert (eq external-format :iso-latin-1-unix)) (make-socket-io-stream (accept socket) external-format)) --- /project/slime/cvsroot/slime/swank-lispworks.lisp 2006/02/10 16:54:01 1.82 +++ /project/slime/cvsroot/slime/swank-lispworks.lisp 2006/03/22 16:40:01 1.83 @@ -67,8 +67,8 @@ (defimplementation accept-connection (socket &key (external-format :iso-latin-1-unix) - buffering) - (declare (ignore buffering)) + buffering timeout) + (declare (ignore buffering timeout)) (assert (eq external-format :iso-latin-1-unix)) (let* ((fd (comm::get-fd-from-socket socket))) (assert (/= fd -1)) --- /project/slime/cvsroot/slime/swank-openmcl.lisp 2006/03/07 09:51:52 1.106 +++ /project/slime/cvsroot/slime/swank-openmcl.lisp 2006/03/22 16:40:01 1.107 @@ -168,8 +168,8 @@ (defimplementation accept-connection (socket &key (external-format :iso-latin-1-unix) - buffering) - (declare (ignore buffering)) + buffering timeout) + (declare (ignore buffering timeout)) (assert (eq external-format :iso-latin-1-unix)) (ccl:accept-connection socket :wait t)) --- /project/slime/cvsroot/slime/swank-sbcl.lisp 2006/01/20 21:31:20 1.152 +++ /project/slime/cvsroot/slime/swank-sbcl.lisp 2006/03/22 16:40:01 1.153 @@ -60,7 +60,8 @@ (defimplementation accept-connection (socket &key (external-format :iso-latin-1-unix) - (buffering :full)) + (buffering :full) timeout) + (declare (ignore timeout)) (make-socket-io-stream (accept socket) external-format buffering)) (defvar *sigio-handlers* '() --- /project/slime/cvsroot/slime/swank-scl.lisp 2006/02/25 17:46:13 1.5 +++ /project/slime/cvsroot/slime/swank-scl.lisp 2006/03/22 16:40:01 1.6 @@ -54,10 +54,23 @@ (defimplementation accept-connection (socket &key (external-format :iso-latin-1-unix) - (buffering :full)) - (let ((external-format (or external-format :iso-latin-1-unix))) - (make-socket-io-stream (ext:accept-tcp-connection socket) - external-format buffering))) + (buffering :full) + (timeout nil)) + (let ((external-format (or external-format :iso-latin-1-unix)) + (fd (socket-fd socket))) + (loop + (let ((ready (sys:wait-until-fd-usable fd :input timeout))) + (unless ready + (error "Timeout accepting connection on socket: ~S~%" socket))) + (let ((new-fd (ignore-errors (ext:accept-tcp-connection fd)))) + (when new-fd + (return (make-socket-io-stream new-fd external-format buffering))))))) + +(defimplementation set-stream-timeout (stream timeout) + (check-type timeout (or null real)) + (if (fboundp 'ext::stream-timeout) + (setf (ext::stream-timeout stream) timeout) + (setf (slot-value (slot-value stream 'cl::stream) 'cl::timeout) timeout))) ;;;;; Sockets --- /project/slime/cvsroot/slime/swank.lisp 2006/03/22 06:06:18 1.367 +++ /project/slime/cvsroot/slime/swank.lisp 2006/03/22 16:40:01 1.368 @@ -424,7 +424,7 @@ (serve-connection socket style dont-close external-format))) (ecase style (:spawn - (spawn (lambda () (loop do (serve) while dont-close)) + (spawn (lambda () (loop do (ignore-errors (serve)) while dont-close)) :name "Swank")) ((:fd-handler :sigio) (add-fd-handler socket (lambda () (serve)))) @@ -432,23 +432,34 @@ port))) (defun serve-connection (socket style dont-close external-format) - (let ((client (accept-authenticated-connection - socket :external-format external-format))) - (unless dont-close - (close-socket socket)) - (let ((connection (create-connection client style external-format))) - (run-hook *new-connection-hook* connection) - (push connection *connections*) - (serve-requests connection)))) + (let ((closed-socket-p nil)) + (unwind-protect + (let ((client (accept-authenticated-connection + socket :external-format external-format))) + (unless dont-close + (close-socket socket) + (setf closed-socket-p t)) + (let ((connection (create-connection client style external-format))) + (run-hook *new-connection-hook* connection) + (push connection *connections*) + (serve-requests connection))) + (unless (or dont-close closed-socket-p) + (close-socket socket))))) (defun accept-authenticated-connection (&rest args) (let ((new (apply #'accept-connection args)) - (secret (slime-secret))) - (when secret - (let ((first-val (decode-message new))) - (unless (and (stringp first-val) (string= first-val secret)) - (close new) - (error "Incoming connection doesn't know the password.")))) + (success nil)) + (unwind-protect + (let ((secret (slime-secret))) + (when secret + (set-stream-timeout new 20) + (let ((first-val (decode-message new))) + (unless (and (stringp first-val) (string= first-val secret)) + (error "Incoming connection doesn't know the password.")))) + (set-stream-timeout new nil) + (setf success t)) + (unless success + (close new :abort t))) new)) (defun slime-secret () @@ -518,16 +529,23 @@ Return an output stream suitable for writing program output. This is an optimized way for Lisp to deliver output to Emacs." - (let* ((socket (create-socket *loopback-interface* - *dedicated-output-stream-port*)) - (port (local-port socket))) - (encode-message `(:open-dedicated-output-stream ,port) socket-io) - (accept-authenticated-connection - socket :external-format external-format - :buffering *dedicated-output-stream-buffering*))) + (let ((socket (create-socket *loopback-interface* + *dedicated-output-stream-port*))) + (unwind-protect + (let ((port (local-port socket))) + (encode-message `(:open-dedicated-output-stream ,port) socket-io) + (let ((dedicated (accept-authenticated-connection + socket :external-format external-format + :buffering *dedicated-output-stream-buffering* + :timeout 30))) + (close-socket socket) + (setf socket nil) + dedicated)) + (when socket + (close-socket socket))))) (defun handle-request (connection) - "Read and process one request. The processing is done in the extend + "Read and process one request. The processing is done in the extent of the toplevel restart." (assert (null *swank-state-stack*)) (let ((*swank-state-stack* '(:handle-request))) @@ -828,34 +846,39 @@ connection)) (defun create-connection (socket-io style external-format) - (let ((c (ecase style - (:spawn - (make-connection :socket-io socket-io - :read #'read-from-control-thread - :send #'send-to-control-thread - :serve-requests #'spawn-threads-for-connection - :cleanup #'cleanup-connection-threads)) - (:sigio - (make-connection :socket-io socket-io - :read #'read-from-socket-io - :send #'send-to-socket-io - :serve-requests #'install-sigio-handler - :cleanup #'deinstall-sigio-handler)) - (:fd-handler - (make-connection :socket-io socket-io - :read #'read-from-socket-io - :send #'send-to-socket-io - :serve-requests #'install-fd-handler - :cleanup #'deinstall-fd-handler)) - ((nil) - (make-connection :socket-io socket-io - :read #'read-from-socket-io - :send #'send-to-socket-io - :serve-requests #'simple-serve-requests))))) - (setf (connection.communication-style c) style) - (setf (connection.external-format c) external-format) - (initialize-streams-for-connection c) - c)) + (let ((success nil)) + (unwind-protect + (let ((c (ecase style + (:spawn + (make-connection :socket-io socket-io + :read #'read-from-control-thread + :send #'send-to-control-thread + :serve-requests #'spawn-threads-for-connection + :cleanup #'cleanup-connection-threads)) + (:sigio + (make-connection :socket-io socket-io + :read #'read-from-socket-io + :send #'send-to-socket-io + :serve-requests #'install-sigio-handler + :cleanup #'deinstall-sigio-handler)) + (:fd-handler + (make-connection :socket-io socket-io + :read #'read-from-socket-io + :send #'send-to-socket-io + :serve-requests #'install-fd-handler + :cleanup #'deinstall-fd-handler)) + ((nil) + (make-connection :socket-io socket-io + :read #'read-from-socket-io + :send #'send-to-socket-io + :serve-requests #'simple-serve-requests))))) + (setf (connection.communication-style c) style) + (setf (connection.external-format c) external-format) + (initialize-streams-for-connection c) + (setf success t) + c) + (unless success + (close socket-io :abort t))))) ;;;; IO to Emacs From mkoeppe at common-lisp.net Wed Mar 22 20:01:44 2006 From: mkoeppe at common-lisp.net (mkoeppe) Date: Wed, 22 Mar 2006 15:01:44 -0500 (EST) Subject: [slime-cvs] CVS slime Message-ID: <20060322200144.D319019015@common-lisp.net> Update of /project/slime/cvsroot/slime In directory clnet:/tmp/cvs-serv22145 Modified Files: swank.lisp Log Message: (arglist-for-echo-area): Fix when arg-indices are not given. --- /project/slime/cvsroot/slime/swank.lisp 2006/03/22 16:40:01 1.368 +++ /project/slime/cvsroot/slime/swank.lisp 2006/03/22 20:01:44 1.369 @@ -1369,7 +1369,8 @@ (format-arglist-for-echo-area form operator-name :print-right-margin print-right-margin - :highlight (and (not (zerop arg-index)) + :highlight (and arg-index + (not (zerop arg-index)) ;; don't highlight the operator arg-index)))))))) (error (cond) From mkoeppe at common-lisp.net Wed Mar 22 20:02:02 2006 From: mkoeppe at common-lisp.net (mkoeppe) Date: Wed, 22 Mar 2006 15:02:02 -0500 (EST) Subject: [slime-cvs] CVS slime Message-ID: <20060322200202.A5BF51F004@common-lisp.net> Update of /project/slime/cvsroot/slime In directory clnet:/tmp/cvs-serv22192 Modified Files: ChangeLog Log Message: *** empty log message *** --- /project/slime/cvsroot/slime/ChangeLog 2006/03/22 16:40:01 1.864 +++ /project/slime/cvsroot/slime/ChangeLog 2006/03/22 20:02:02 1.865 @@ -27,6 +27,9 @@ 2006-03-22 Matthias Koeppe + * swank.lisp (arglist-for-echo-area): Fix when arg-indices are + not given. + * slime.el (slime-ed): Handle (FILENAME :charpos CHARPOS). * swank.lisp (inspect-for-emacs): Specialize on FILE-STREAM and From mkoeppe at common-lisp.net Wed Mar 22 23:18:54 2006 From: mkoeppe at common-lisp.net (mkoeppe) Date: Wed, 22 Mar 2006 18:18:54 -0500 (EST) Subject: [slime-cvs] CVS slime Message-ID: <20060322231854.2A1125E0D2@common-lisp.net> Update of /project/slime/cvsroot/slime In directory clnet:/tmp/cvs-serv16282 Modified Files: swank.lisp Log Message: (casify): Removed. (casify-char, tokenize-symbol-thoroughly): New functions. (parse-symbol): Use tokenize-symbol-thoroughly, so as to handle |escaped symbols|. --- /project/slime/cvsroot/slime/swank.lisp 2006/03/22 20:01:44 1.369 +++ /project/slime/cvsroot/slime/swank.lisp 2006/03/22 23:18:53 1.370 @@ -1276,28 +1276,55 @@ (internp (search "::" string))) (values symbol package internp))) -;; FIXME: Escape chars are ignored -(defun casify (string) - "Convert string accoring to readtable-case." +(defun tokenize-symbol-thoroughly (string) + "This version of tokenize-symbol handles escape characters." + (let ((package nil) + (token (make-array (length string) :element-type 'character + :fill-pointer 0)) + (backslash nil) + (vertical nil) + (internp nil)) + (loop for char across string + do (cond + (backslash + (vector-push-extend char token) + (setq backslash nil)) + ((char= char #\\) ; Quotes next character, even within |...| + (setq backslash t)) + ((char= char #\|) + (setq vertical t)) + (vertical + (vector-push-extend char token)) + ((char= char #\:) + (if package + (setq internp t) + (setq package token + token (make-array (length string) + :element-type 'character + :fill-pointer 0)))) + (t + (vector-push-extend (casify-char char) token)))) + (values token package internp))) + +(defun casify-char (char) + "Convert CHAR accoring to readtable-case." (ecase (readtable-case *readtable*) - (:preserve string) - (:upcase (string-upcase string)) - (:downcase (string-downcase string)) - (:invert (multiple-value-bind (lower upper) (determine-case string) - (cond ((and lower upper) string) - (lower (string-upcase string)) - (upper (string-downcase string)) - (t string)))))) + (:preserve char) + (:upcase (char-upcase char)) + (:downcase (char-downcase char)) + (:invert (if (upper-case-p char) + (char-downcase char) + (char-upcase char))))) (defun parse-symbol (string &optional (package *package*)) "Find the symbol named STRING. Return the symbol and a flag indicating whether the symbols was found." - (multiple-value-bind (sname pname) (tokenize-symbol string) + (multiple-value-bind (sname pname) (tokenize-symbol-thoroughly string) (let ((package (cond ((string= pname "") keyword-package) - (pname (find-package (casify pname))) + (pname (find-package pname)) (t package)))) (if package - (find-symbol (casify sname) package) + (find-symbol sname package) (values nil nil))))) (defun parse-symbol-or-lose (string &optional (package *package*)) From mkoeppe at common-lisp.net Wed Mar 22 23:20:42 2006 From: mkoeppe at common-lisp.net (mkoeppe) Date: Wed, 22 Mar 2006 18:20:42 -0500 (EST) Subject: [slime-cvs] CVS slime Message-ID: <20060322232042.9CD4A63035@common-lisp.net> Update of /project/slime/cvsroot/slime In directory clnet:/tmp/cvs-serv16409 Modified Files: ChangeLog Log Message: *** empty log message *** --- /project/slime/cvsroot/slime/ChangeLog 2006/03/22 20:02:02 1.865 +++ /project/slime/cvsroot/slime/ChangeLog 2006/03/22 23:20:42 1.866 @@ -1,3 +1,11 @@ +2006-03-23 Matthias Koeppe + + * swank.lisp (casify): Removed. + (casify-char, tokenize-symbol-thoroughly): New functions. + (parse-symbol): Use tokenize-symbol-thoroughly, so as to handle + |escaped symbols|. This fixes arglist display for operators with + strange symbol names. + 2006-03-23 Douglas Crosher * swank-backend (accept-connection): add a 'timeout argument to From mkoeppe at common-lisp.net Thu Mar 23 05:01:41 2006 From: mkoeppe at common-lisp.net (mkoeppe) Date: Thu, 23 Mar 2006 00:01:41 -0500 (EST) Subject: [slime-cvs] CVS slime Message-ID: <20060323050141.D3E0D68120@common-lisp.net> Update of /project/slime/cvsroot/slime In directory clnet:/tmp/cvs-serv29704 Modified Files: slime.el Log Message: * slime.el (slime-qualify-cl-symbol-name): Strip leading colon from package names for qualifying symbols. (slime-call-defun): New command. (slime-keys): Bind it to C-c C-y. (slime-easy-menu): Show it in the menu. * slime.el (slime-autodoc-use-multiline-p): New defcustom. (slime-autodoc-message): Use it here. Fix bug that autodoc messages exceeding one line could not be overwritten by later autodoc messages. (slime-autodoc-pre-command-refresh-echo-area): Use message rather than slime-background-message. --- /project/slime/cvsroot/slime/slime.el 2006/03/22 02:48:26 1.601 +++ /project/slime/cvsroot/slime/slime.el 2006/03/23 05:01:40 1.602 @@ -657,6 +657,7 @@ ("\C-\M-x" slime-eval-defun) (":" slime-interactive-eval :prefixed t :sldb t) ("\C-e" slime-interactive-eval :prefixed t :sldb t :inferior t) + ("\C-y" slime-call-defun :prefixed t) ("E" slime-edit-value :prefixed t :sldb t :inferior t) ("\C-z" slime-switch-to-output-buffer :prefixed t :sldb t) ("\C-b" slime-interrupt :prefixed t :inferior t :sldb t) @@ -793,7 +794,8 @@ [ "Eval Region" slime-eval-region ,C ] [ "Scratch Buffer" slime-scratch ,C ] [ "Interactive Eval..." slime-interactive-eval ,C ] - [ "Edit Lisp Value..." slime-edit-value ,C ]) + [ "Edit Lisp Value..." slime-edit-value ,C ] + [ "Call Defun" slime-call-defun ,C ]) ("Debugging" [ "Macroexpand Once..." slime-macroexpand-1 ,C ] [ "Macroexpand All..." slime-macroexpand-all ,C ] @@ -5388,14 +5390,26 @@ (slime-update-autodoc-cache cache-key doc) (slime-autodoc-message doc))))))) +(defcustom slime-autodoc-use-multiline-p nil + "If non-nil, allow long autodoc messages to resize echo area display." + :group 'slime-ui) + (defun slime-autodoc-message (doc) - (setq slime-autodoc-last-message doc) - (slime-background-message "%s" doc)) + "Display the autodoc documentation string DOC." + (cond + ((slime-typeout-active-p) + (setq slime-autodoc-last-message "") ; no need for refreshing + (slime-typeout-message doc)) + (t + (unless slime-autodoc-use-multiline-p + (setq doc (slime-oneliner doc))) + (setq slime-autodoc-last-message doc) + (message "%s" doc)))) (defun slime-autodoc-pre-command-refresh-echo-area () (unless (string= slime-autodoc-last-message "") (if (slime-autodoc-message-ok-p) - (slime-background-message "%s" slime-autodoc-last-message) + (message "%s" slime-autodoc-last-message) (setq slime-autodoc-last-message "")))) (defun slime-autodoc-thing-at-point () @@ -6577,6 +6591,21 @@ (insert "\n") (slime-eval-print string)) +(defun slime-call-defun () + (interactive) + "Insert a call to the function defined around point into the REPL." + (let ((toplevel (slime-parse-toplevel-form))) + (unless (and (consp toplevel) + (member (car toplevel) '(:defun :defmethod :defgeneric)) + (symbolp (cadr toplevel))) + (error "Not in a function definition")) + (let* ((symbol (cadr toplevel)) + (function-call + (format "(%s " (slime-qualify-cl-symbol-name symbol)))) + (slime-switch-to-output-buffer) + (goto-char slime-repl-input-start-mark) + (insert function-call)))) + ;;;; Edit Lisp value ;;; (defun slime-edit-value (form-string) @@ -9877,7 +9906,11 @@ (if (slime-cl-symbol-package s) s (format "%s::%s" - (slime-current-package) + (let* ((package (slime-current-package))) + ;; package is a string like ":cl-user" or "CL-USER". + (if (and package (string-match "^:" package)) + (substring package 1) + package)) (slime-cl-symbol-name s))))) From mkoeppe at common-lisp.net Thu Mar 23 05:02:55 2006 From: mkoeppe at common-lisp.net (mkoeppe) Date: Thu, 23 Mar 2006 00:02:55 -0500 (EST) Subject: [slime-cvs] CVS slime Message-ID: <20060323050255.3192F68121@common-lisp.net> Update of /project/slime/cvsroot/slime In directory clnet:/tmp/cvs-serv29800 Modified Files: ChangeLog Log Message: --- /project/slime/cvsroot/slime/ChangeLog 2006/03/22 23:20:42 1.866 +++ /project/slime/cvsroot/slime/ChangeLog 2006/03/23 05:02:54 1.867 @@ -1,5 +1,18 @@ 2006-03-23 Matthias Koeppe + * slime.el (slime-qualify-cl-symbol-name): Strip leading colon + from package names for qualifying symbols. + (slime-call-defun): New command. + (slime-keys): Bind it to C-c C-y. + (slime-easy-menu): Show it in the menu. + + * slime.el (slime-autodoc-use-multiline-p): New defcustom. + (slime-autodoc-message): Use it here. Fix bug that autodoc + messages exceeding one line could not be overwritten by later + autodoc messages. + (slime-autodoc-pre-command-refresh-echo-area): Use message + rather than slime-background-message. + * swank.lisp (casify): Removed. (casify-char, tokenize-symbol-thoroughly): New functions. (parse-symbol): Use tokenize-symbol-thoroughly, so as to handle From crhodes at common-lisp.net Thu Mar 23 07:14:13 2006 From: crhodes at common-lisp.net (crhodes) Date: Thu, 23 Mar 2006 02:14:13 -0500 (EST) Subject: [slime-cvs] CVS slime Message-ID: <20060323071413.0A9C422007@common-lisp.net> Update of /project/slime/cvsroot/slime In directory clnet:/tmp/cvs-serv12269 Modified Files: ChangeLog slime.el swank.lisp Log Message: Allow swank:ed-in-emacs to take cons function names. (This adds some ambiguity with conses representing filenames and positions) --- /project/slime/cvsroot/slime/ChangeLog 2006/03/23 05:02:54 1.867 +++ /project/slime/cvsroot/slime/ChangeLog 2006/03/23 07:14:13 1.868 @@ -1,3 +1,13 @@ +2006-03-23 Christophe Rhodes + + * swank.lisp (ed-in-emacs): Allow conses as function names. + Ensure that there is a connection to emacs before sending the + :ed message. + + * slime.el (slime-edit-definition): read names, not symbols. + (slime-ed): handle conses whose car is not a string as function + names. + 2006-03-23 Matthias Koeppe * slime.el (slime-qualify-cl-symbol-name): Strip leading colon --- /project/slime/cvsroot/slime/slime.el 2006/03/23 05:01:40 1.602 +++ /project/slime/cvsroot/slime/slime.el 2006/03/23 07:14:13 1.603 @@ -6281,10 +6281,10 @@ dspec location) (defun slime-edit-definition (name &optional where) - "Lookup the definition of the symbol at point. -If there's no symbol at point, or a prefix argument is given, then the + "Lookup the definition of the name at point. +If there's no name at point, or a prefix argument is given, then the function name is prompted." - (interactive (list (slime-read-symbol-name "Symbol: "))) + (interactive (list (slime-read-symbol-name "Name: "))) (let ((definitions (slime-eval `(swank:find-definitions-for-emacs ,name)))) (if (null definitions) (if slime-edit-definition-fallback-function @@ -6426,7 +6426,7 @@ A filename (string), A list (FILENAME LINE [COLUMN]), A list (FILENAME :charpos CHARPOS), - A function name (symbol), + A function name (symbol or cons), nil. This is for use in the implementation of COMMON-LISP:ED." @@ -6439,7 +6439,7 @@ (select-frame slime-ed-frame)) (cond ((stringp what) (find-file (slime-from-lisp-filename what))) - ((consp what) + ((and (consp what) (stringp (first what))) (find-file (first (slime-from-lisp-filename what))) (cond ((eql (second what) :charpos) @@ -6455,6 +6455,8 @@ (forward-char 1)))))) ((and what (symbolp what)) (slime-edit-definition (symbol-name what))) + ((consp what) + (slime-edit-definition (prin1-to-string what))) (t nil)))) ; nothing in particular --- /project/slime/cvsroot/slime/swank.lisp 2006/03/22 23:18:53 1.370 +++ /project/slime/cvsroot/slime/swank.lisp 2006/03/23 07:14:13 1.371 @@ -2244,7 +2244,7 @@ WHAT can be: A pathname or a string, A list (PATHNAME-OR-STRING LINE [COLUMN]), - A function name (symbol), + A function name (symbol or cons), NIL. Returns true if it actually called emacs, or NIL if not." @@ -2256,9 +2256,14 @@ ((pathname-or-string-p what) (canonicalize-filename what)) ((symbolp what) what) + ((consp what) what) (t (return-from ed-in-emacs nil))))) - (send-oob-to-emacs `(:ed ,target)) - t))) + (cond + (*emacs-connection* (send-oob-to-emacs `(:ed ,target))) + ((default-connection) + (with-connection ((default-connection)) + (send-oob-to-emacs `(:ed ,target)))) + (t nil))))) (defslimefun value-for-editing (form) "Return a readable value of FORM for editing in Emacs. From mkoeppe at common-lisp.net Thu Mar 23 23:27:41 2006 From: mkoeppe at common-lisp.net (mkoeppe) Date: Thu, 23 Mar 2006 18:27:41 -0500 (EST) Subject: [slime-cvs] CVS slime Message-ID: <20060323232741.CB26915006@common-lisp.net> Update of /project/slime/cvsroot/slime In directory clnet:/tmp/cvs-serv16279 Modified Files: slime.el Log Message: (slime-background-activities-enabled-p): Allow "background activities" in sldb-mode. (slime-autodoc-message-ok-p): Allow autodoc in sldb-mode. (sldb-mode-syntax-table): New variable. (sldb-mode): Enable autodoc-mode when slime-use-autodoc-mode is true. Use sldb-mode-syntax-table to make #<...> balance like parentheses. This enables autodoc-mode to match # actual arguments in the backtraces with formal arguments of the function. (slime-beginning-of-symbol, slime-end-of-symbol): Handle es::|caped| symbols. (slime-enclosing-operator-names): Use syntax table to check whether we are at the beginning of a balanced expression. --- /project/slime/cvsroot/slime/slime.el 2006/03/23 07:14:13 1.603 +++ /project/slime/cvsroot/slime/slime.el 2006/03/23 23:27:41 1.604 @@ -2225,6 +2225,7 @@ (defun slime-background-activities-enabled-p () (and (or slime-mode + (eq major-mode 'sldb-mode) (eq major-mode 'slime-repl-mode)) (let ((con (slime-current-connection))) (and con @@ -5505,7 +5506,8 @@ (defun slime-autodoc-message-ok-p () "Return true if printing a message is currently okay (shouldn't annoy the user)." - (and (or slime-mode (eq major-mode 'slime-repl-mode)) + (and (or slime-mode (eq major-mode 'slime-repl-mode) + (eq major-mode 'sldb-mode)) slime-autodoc-mode (or (null (current-message)) (string= (current-message) slime-autodoc-last-message)) @@ -7498,6 +7500,19 @@ ;;;;; sldb-mode +(defvar sldb-mode-syntax-table + (let ((table (copy-syntax-table lisp-mode-syntax-table))) + ;; We give < and > parenthesis syntax, so that #< ... > is treated + ;; as a balanced expression. This enables autodoc-mode to match + ;; # actual arguments in the backtraces with formal + ;; arguments of the function. (For Lisp mode, this is not + ;; desirable, since we do not wish to get a mismatched paren + ;; highlighted everytime we type < or >.) + (modify-syntax-entry ?< "(" table) + (modify-syntax-entry ?> ")" table) + table) + "Syntax table for SLDB mode.") + (define-derived-mode sldb-mode fundamental-mode "sldb" "Superior lisp debugger mode. In addition to ordinary SLIME commands, the following are available:\\ @@ -7534,8 +7549,10 @@ \\{sldb-mode-map}" (erase-buffer) - (set-syntax-table lisp-mode-syntax-table) + (set-syntax-table sldb-mode-syntax-table) (slime-set-truncate-lines) + (when slime-use-autodoc-mode + (slime-autodoc-mode 1)) ;; Make original slime-connection "sticky" for SLDB commands in this buffer (setq slime-buffer-connection (slime-connection)) (make-local-variable 'kill-buffer-hook) @@ -9933,13 +9950,22 @@ (defun slime-beginning-of-symbol () "Move point to the beginning of the current symbol." - (and (minusp (skip-syntax-backward "w_")) - (when (eq (char-before) ?#) ; special case for things like "# (point) (point-min))) (incf arg-index)) (backward-up-list 1) - (when (looking-at "(") + (when (member (char-syntax (char-after)) '(?\( ?')) (incf level) (forward-char 1) (when-let (name (slime-symbol-name-at-point)) From mkoeppe at common-lisp.net Thu Mar 23 23:28:07 2006 From: mkoeppe at common-lisp.net (mkoeppe) Date: Thu, 23 Mar 2006 18:28:07 -0500 (EST) Subject: [slime-cvs] CVS slime Message-ID: <20060323232807.8923719006@common-lisp.net> Update of /project/slime/cvsroot/slime In directory clnet:/tmp/cvs-serv16342 Modified Files: ChangeLog Log Message: --- /project/slime/cvsroot/slime/ChangeLog 2006/03/23 07:14:13 1.868 +++ /project/slime/cvsroot/slime/ChangeLog 2006/03/23 23:28:07 1.869 @@ -1,3 +1,19 @@ +2006-03-24 Matthias Koeppe + + * slime.el (slime-background-activities-enabled-p): Allow + "background activities" in sldb-mode. + (slime-autodoc-message-ok-p): Allow autodoc in sldb-mode. + (sldb-mode-syntax-table): New variable. + (sldb-mode): Enable autodoc-mode when slime-use-autodoc-mode is + true. Use sldb-mode-syntax-table to make #<...> balance like + parentheses. This enables autodoc-mode to match # + actual arguments in the backtraces with formal arguments of the + function. + (slime-beginning-of-symbol, slime-end-of-symbol): Handle + es::|caped| symbols. + (slime-enclosing-operator-names): Use syntax table to check + whether we are at the beginning of a balanced expression. + 2006-03-23 Christophe Rhodes * swank.lisp (ed-in-emacs): Allow conses as function names. From mkoeppe at common-lisp.net Fri Mar 24 07:30:18 2006 From: mkoeppe at common-lisp.net (mkoeppe) Date: Fri, 24 Mar 2006 02:30:18 -0500 (EST) Subject: [slime-cvs] CVS slime Message-ID: <20060324073018.F2E9972034@common-lisp.net> Update of /project/slime/cvsroot/slime In directory clnet:/tmp/cvs-serv11297 Modified Files: swank-allegro.lisp Log Message: (set-default-directory): Fix for pathnames without a trailing slash. >From Mikel Bankcroft --- /project/slime/cvsroot/slime/swank-allegro.lisp 2006/03/22 16:40:01 1.85 +++ /project/slime/cvsroot/slime/swank-allegro.lisp 2006/03/24 07:30:18 1.86 @@ -86,9 +86,8 @@ "allegro") (defimplementation set-default-directory (directory) - (let ((dir (namestring (setf *default-pathname-defaults* - (truename (merge-pathnames directory)))))) - (excl:chdir dir) + (let* ((dir (namestring (truename (merge-pathnames directory))))) + (setf *default-pathname-defaults* (pathname (excl:chdir dir))) dir)) (defimplementation default-directory () From mkoeppe at common-lisp.net Fri Mar 24 07:30:34 2006 From: mkoeppe at common-lisp.net (mkoeppe) Date: Fri, 24 Mar 2006 02:30:34 -0500 (EST) Subject: [slime-cvs] CVS slime Message-ID: <20060324073034.EAF6C3053@common-lisp.net> Update of /project/slime/cvsroot/slime In directory clnet:/tmp/cvs-serv11375 Modified Files: ChangeLog Log Message: *** empty log message *** --- /project/slime/cvsroot/slime/ChangeLog 2006/03/23 23:28:07 1.869 +++ /project/slime/cvsroot/slime/ChangeLog 2006/03/24 07:30:34 1.870 @@ -1,3 +1,8 @@ +2006-03-24 Mikel Bancroft + + * swank-allegro.lisp (set-default-directory): Fix for pathnames + without a trailing slash. + 2006-03-24 Matthias Koeppe * slime.el (slime-background-activities-enabled-p): Allow From mkoeppe at common-lisp.net Sun Mar 26 03:51:56 2006 From: mkoeppe at common-lisp.net (mkoeppe) Date: Sat, 25 Mar 2006 22:51:56 -0500 (EST) Subject: [slime-cvs] CVS slime Message-ID: <20060326035156.59A637057@common-lisp.net> Update of /project/slime/cvsroot/slime In directory clnet:/tmp/cvs-serv7608 Modified Files: slime.el Log Message: (slime-fontify-string): Fix for arguments spanning multiple lines. (slime-autodoc-message-dimensions): New. (slime-autodoc-thing-at-point): Use it here to either ask for a one-line or a nicely formatted multi-line arglist. (slime-enclosing-operator-names): Handle linebreaks. --- /project/slime/cvsroot/slime/slime.el 2006/03/23 23:27:41 1.604 +++ /project/slime/cvsroot/slime/slime.el 2006/03/26 03:51:56 1.605 @@ -5268,7 +5268,7 @@ (let ((font-lock-verbose nil)) (font-lock-fontify-buffer)) (goto-char (point-min)) - (when (re-search-forward "===> \\(.*\\) <===" nil t) + (when (re-search-forward "===> \\(\\(.\\|\n\\)*\\) <===" nil t) (let ((highlight (propertize (match-string 1) 'face 'highlight))) ;; Can't use (replace-match highlight) here -- broken in Emacs 21 (delete-region (match-beginning 0) (match-end 0)) @@ -5407,6 +5407,24 @@ (setq slime-autodoc-last-message doc) (message "%s" doc)))) +(defun slime-autodoc-message-dimensions () + "Return the available width and height for pretty printing autodoc +messages." + (cond + ((slime-typeout-active-p) + ;; Use the full width of the typeout window; + ;; we don't care about the height, as typeout window can be scrolled + (values (window-width slime-typeout-window) + nil)) + (slime-autodoc-use-multiline-p + ;; Use the full width of the minibuffer; + ;; minibuffer will grow vertically if necessary + (values (window-width (minibuffer-window)) + nil)) + (t + ;; Try to fit everything in one line; we cut off when displaying + (values 1000 1)))) + (defun slime-autodoc-pre-command-refresh-echo-area () (unless (string= slime-autodoc-last-message "") (if (slime-autodoc-message-ok-p) @@ -5428,12 +5446,12 @@ designator) arg-index)) operators arg-indices) - `(swank:arglist-for-echo-area ',operators - :arg-indices - ',arg-indices - :print-right-margin - ,(window-width - (minibuffer-window)))))))) + (multiple-value-bind (width height) + (slime-autodoc-message-dimensions) + `(swank:arglist-for-echo-area ',operators + :arg-indices ',arg-indices + :print-right-margin ,width + :print-lines ,height))))))) (defun slime-autodoc-global-at-point () "Return the global variable name at point, if any." @@ -10029,7 +10047,7 @@ (let ((arg-index 0)) ;; Move to the beginning of the current sexp if not already there. (if (or (member (char-syntax (char-after)) '(?\( ?')) - (= (char-syntax (char-before)) ?\ )) + (member (char-syntax (char-before)) '(?\ ?>))) (incf arg-index)) (ignore-errors (backward-sexp 1)) From mkoeppe at common-lisp.net Sun Mar 26 03:57:37 2006 From: mkoeppe at common-lisp.net (mkoeppe) Date: Sat, 25 Mar 2006 22:57:37 -0500 (EST) Subject: [slime-cvs] CVS slime Message-ID: <20060326035737.C643B7A000@common-lisp.net> Update of /project/slime/cvsroot/slime In directory clnet:/tmp/cvs-serv7916 Modified Files: swank.lisp Log Message: (arglist-for-echo-area): New keyword arg, print-lines. (decoded-arglist-to-string): New function, implement argument highlighting also for &optional and &rest/&body arguments. (arglist-to-string): Use decoded-arglist-to-string. (arglist): New slots aux-args, known-junk, unknown-junk. (nreversef): New macro. (decode-arglist, encode-arglist): Refine to handle more structure in argument lists, including implementation-defined stuff like &parse-body. (format-arglist-for-echo-area): New keyword arg, print-lines. Simplify the code as there is no need to fall back to the unparsed arglist any more. --- /project/slime/cvsroot/slime/swank.lisp 2006/03/23 07:14:13 1.371 +++ /project/slime/cvsroot/slime/swank.lisp 2006/03/26 03:57:37 1.372 @@ -1379,7 +1379,7 @@ ;;;; Arglists (defslimefun arglist-for-echo-area (names &key print-right-margin - arg-indices) + print-lines arg-indices) "Return the arglist for the first function, macro, or special-op in NAMES." (handler-case (with-buffer-syntax () @@ -1396,6 +1396,7 @@ (format-arglist-for-echo-area form operator-name :print-right-margin print-right-margin + :print-lines print-lines :highlight (and arg-index (not (zerop arg-index)) ;; don't highlight the operator @@ -1426,49 +1427,82 @@ '()) (t (cons (car arglist) (clean-arglist (cdr arglist)))))) +(defun decoded-arglist-to-string (arglist package + &key operator print-right-margin + print-lines highlight) + "Print the decoded ARGLIST for display in the echo area. The +argument name are printed without package qualifiers and pretty +printing of (function foo) as #'foo is suppressed. If HIGHLIGHT is +non-nil, it must be the index of an argument; highlight this argument. +If OPERATOR is non-nil, put it in front of the arglist." + (with-output-to-string (*standard-output*) + (with-standard-io-syntax + (let ((*package* package) (*print-case* :downcase) + (*print-pretty* t) (*print-circle* nil) (*print-readably* nil) + (*print-level* 10) (*print-length* 20) + (*print-right-margin* print-right-margin) + (*print-lines* print-lines)) + (let ((index 0) + (first-arg t)) + (labels ((print-arg (arg) + (etypecase arg + (symbol (princ arg)) + (string (princ arg)) + (cons (pprint-logical-block (nil nil :prefix "(" :suffix ")") + (princ (car arg)) + (unless (null (cdr arg)) + (write-char #\space)) + (pprint-fill *standard-output* (cdr arg) nil))))) + (print-space () + (unless first-arg + (write-char #\space) + (pprint-newline :fill)) + (setf first-arg nil)) + (print-with-space (obj) + (print-space) + (print-arg obj)) + (print-with-highlight (arg &optional (index-ok-p #'=)) + (print-space) + (cond + ((and highlight (funcall index-ok-p index highlight)) + (princ "===> ") + (print-arg arg) + (princ " <===")) + (t + (print-arg arg))) + (incf index))) + (pprint-logical-block (nil nil :prefix "(" :suffix ")") + (when operator + (print-with-highlight operator)) + (mapc #'print-with-highlight + (arglist.required-args arglist)) + (when (arglist.optional-args arglist) + (print-with-space '&optional) + (mapc #'print-with-highlight + (mapcar #'encode-optional-arg + (arglist.optional-args arglist)))) + (when (arglist.key-p arglist) + (print-with-space '&key) + (mapc #'print-with-space + (mapcar #'encode-keyword-arg + (arglist.keyword-args arglist)))) + (when (arglist.allow-other-keys-p arglist) + (print-with-space '&allow-other-keys)) + (cond ((not (arglist.rest arglist))) + ((arglist.body-p arglist) + (print-with-space '&body) + (print-with-highlight (arglist.rest arglist) #'<=)) + (t + (print-with-space '&rest) + (print-with-highlight (arglist.rest arglist) #'<=))) + (mapc #'print-with-space + (arglist.unknown-junk arglist))))))))) + (defun arglist-to-string (arglist package &key print-right-margin highlight) - "Print the list ARGLIST for display in the echo area. -The argument name are printed without package qualifiers and -pretty printing of (function foo) as #'foo is suppressed. -If HIGHLIGHT is non-nil, it must be the index of an argument; -highlight this argument." - (setq arglist (clean-arglist arglist)) - (etypecase arglist - (null "()") - (cons - (with-output-to-string (*standard-output*) - (with-standard-io-syntax - (let ((*package* package) (*print-case* :downcase) - (*print-pretty* t) (*print-circle* nil) (*print-readably* nil) - (*print-level* 10) (*print-length* 20) - (*print-right-margin* print-right-margin)) - (let ((index 0)) - (pprint-logical-block (nil nil :prefix "(" :suffix ")") - (loop - (let ((arg (pop arglist))) - (when (member arg lambda-list-keywords) - ;; The highlighting code is currently only - ;; prepared for the required arguments. To - ;; extend it to work with optional and keyword - ;; arguments as well, arglist-to-string should - ;; get a DECODED-ARGLIST instead. --mkoeppe - (setq highlight nil)) - (when (and highlight (= index highlight)) - (princ "===> ")) - (etypecase arg - (symbol (princ arg)) - (string (princ arg)) - (cons (pprint-logical-block (nil nil :prefix "(" :suffix ")") - (princ (car arg)) - (unless (null (cdr arg)) - (write-char #\space)) - (pprint-fill *standard-output* (cdr arg) nil)))) - (when (and highlight (= index highlight)) - (princ " <===")) - (incf index) - (when (null arglist) (return)) - (write-char #\space) - (pprint-newline :fill))))))))))) + (decoded-arglist-to-string (decode-arglist arglist) + package + :print-right-margin print-right-margin + :highlight highlight)) (defun test-print-arglist (list string) (string= (arglist-to-string list (find-package :swank)) string)) @@ -1576,7 +1610,12 @@ keyword-args ; list of the keywords rest ; name of the &rest or &body argument (if any) body-p ; whether the rest argument is a &body - allow-other-keys-p) ; whether &allow-other-keys appeared + allow-other-keys-p ; whether &allow-other-keys appeared + aux-args ; list of &aux variables + known-junk ; &whole, &environment + unknown-junk) ; unparsed stuff + +(define-modify-macro nreversef () nreverse "Reverse the list in PLACE.") (defun decode-arglist (arglist) "Parse the list ARGLIST and return an ARGLIST structure." @@ -1584,15 +1623,25 @@ (result (make-arglist))) (dolist (arg arglist) (cond + ((eql mode '&unknown-junk) + ;; don't leave this mode -- we don't know how the arglist + ;; after unknown lambda-list keywords is interpreted + (push arg (arglist.unknown-junk result))) ((eql arg '&allow-other-keys) (setf (arglist.allow-other-keys-p result) t)) ((eql arg '&key) (setf (arglist.key-p result) t mode arg)) - ((member arg lambda-list-keywords) + ((member arg '(&optional &rest &body &aux)) (setq mode arg)) + ((member arg '(&whole &environment)) + (setq mode arg) + (push arg (arglist.known-junk result))) + ((member arg lambda-list-keywords) + (setq mode '&unknown-junk) + (push arg (arglist.unknown-junk result))) (t - (case mode + (ecase mode (&key (push (decode-keyword-arg arg) (arglist.keyword-args result))) @@ -1604,16 +1653,20 @@ (arglist.rest result) arg)) (&rest (setf (arglist.rest result) arg)) + (&aux + (push (decode-optional-arg arg) + (arglist.aux-args result))) ((nil) (push arg (arglist.required-args result))) ((&whole &environment) - (setf mode nil)))))) - (setf (arglist.required-args result) - (nreverse (arglist.required-args result))) - (setf (arglist.optional-args result) - (nreverse (arglist.optional-args result))) - (setf (arglist.keyword-args result) - (nreverse (arglist.keyword-args result))) + (setf mode nil) + (push arg (arglist.known-junk result))))))) + (nreversef (arglist.required-args result)) + (nreversef (arglist.optional-args result)) + (nreversef (arglist.keyword-args result)) + (nreversef (arglist.aux-args result)) + (nreversef (arglist.known-junk result)) + (nreversef (arglist.unknown-junk result)) result)) (defun encode-arglist (decoded-arglist) @@ -1631,7 +1684,11 @@ ((arglist.body-p decoded-arglist) `(&body ,(arglist.rest decoded-arglist))) (t - `(&rest ,(arglist.rest decoded-arglist)))))) + `(&rest ,(arglist.rest decoded-arglist)))) + (when (arglist.aux-args decoded-arglist) + `(&aux ,(arglist.aux-args decoded-arglist))) + (arglist.known-junk decoded-arglist) + (arglist.unknown-junk decoded-arglist))) (defun arglist-keywords (arglist) "Return the list of keywords in ARGLIST. @@ -1908,39 +1965,24 @@ :not-available)) (defun format-arglist-for-echo-area (form operator-name - &key print-right-margin highlight) + &key print-right-margin print-lines + highlight) "Return the arglist for FORM as a string." (when (consp form) (let ((operator-form (first form)) (argument-forms (rest form))) - (multiple-value-bind (form-completion any-enrichment) - (form-completion operator-form argument-forms - :remove-args nil) - (cond - ((eql form-completion :not-available) - nil) - ((not any-enrichment) - ;; Just use the original arglist. - ;; This works better for implementation-specific - ;; lambda-list-keywords like CMUCL's &parse-body. - (let ((arglist (arglist operator-form))) - (etypecase arglist - ((member :not-available) - nil) - (list - (return-from format-arglist-for-echo-area - (arglist-to-string (cons operator-name arglist) - *package* - :print-right-margin print-right-margin - :highlight highlight)))))) - (t - (return-from format-arglist-for-echo-area - (arglist-to-string - (cons operator-name - (encode-arglist form-completion)) - *package* - :print-right-margin print-right-margin - :highlight highlight))))))) + (let ((form-completion + (form-completion operator-form argument-forms + :remove-args nil))) + (unless (eql form-completion :not-available) + (return-from format-arglist-for-echo-area + (decoded-arglist-to-string + form-completion + *package* + :operator operator-name + :print-right-margin print-right-margin + :print-lines print-lines + :highlight highlight)))))) nil) (defslimefun completions-for-keyword (name keyword-string) From mkoeppe at common-lisp.net Sun Mar 26 03:58:16 2006 From: mkoeppe at common-lisp.net (mkoeppe) Date: Sat, 25 Mar 2006 22:58:16 -0500 (EST) Subject: [slime-cvs] CVS slime Message-ID: <20060326035816.AFD947A001@common-lisp.net> Update of /project/slime/cvsroot/slime In directory clnet:/tmp/cvs-serv7962 Modified Files: ChangeLog Log Message: *** empty log message *** --- /project/slime/cvsroot/slime/ChangeLog 2006/03/24 07:30:34 1.870 +++ /project/slime/cvsroot/slime/ChangeLog 2006/03/26 03:58:16 1.871 @@ -1,3 +1,26 @@ +2006-03-25 Matthias Koeppe + + * swank.lisp (arglist-for-echo-area): New keyword arg, + print-lines. + (decoded-arglist-to-string): New function, implement argument + highlighting also for &optional and &rest/&body arguments. + (arglist-to-string): Use decoded-arglist-to-string. + (arglist): New slots aux-args, known-junk, unknown-junk. + (nreversef): New macro. + (decode-arglist, encode-arglist): Refine to handle more structure + in argument lists, including implementation-defined stuff like + &parse-body. + (format-arglist-for-echo-area): New keyword arg, print-lines. + Simplify the code as there is no need to fall back to the unparsed + arglist any more. + + * slime.el (slime-fontify-string): Fix for arguments spanning + multiple lines. + (slime-autodoc-message-dimensions): New. + (slime-autodoc-thing-at-point): Use it here to either ask for a + one-line or a nicely formatted multi-line arglist. + (slime-enclosing-operator-names): Handle linebreaks. + 2006-03-24 Mikel Bancroft * swank-allegro.lisp (set-default-directory): Fix for pathnames From mkoeppe at common-lisp.net Sun Mar 26 04:24:04 2006 From: mkoeppe at common-lisp.net (mkoeppe) Date: Sat, 25 Mar 2006 23:24:04 -0500 (EST) Subject: [slime-cvs] CVS slime Message-ID: <20060326042404.ADA8A111C7@common-lisp.net> Update of /project/slime/cvsroot/slime In directory clnet:/tmp/cvs-serv10955 Modified Files: swank.lisp Log Message: Move arglist test code down where all used functions are defined. --- /project/slime/cvsroot/slime/swank.lisp 2006/03/26 03:57:37 1.372 +++ /project/slime/cvsroot/slime/swank.lisp 2006/03/26 04:24:04 1.373 @@ -1498,26 +1498,6 @@ (mapc #'print-with-space (arglist.unknown-junk arglist))))))))) -(defun arglist-to-string (arglist package &key print-right-margin highlight) - (decoded-arglist-to-string (decode-arglist arglist) - package - :print-right-margin print-right-margin - :highlight highlight)) - -(defun test-print-arglist (list string) - (string= (arglist-to-string list (find-package :swank)) string)) - -;; Should work: -(progn - (assert (test-print-arglist '(function cons) "(function cons)")) - (assert (test-print-arglist '(quote cons) "(quote cons)")) - (assert (test-print-arglist '(&key (function #'+)) "(&key (function #'+))")) - (assert (test-print-arglist '(&whole x y z) "(y z)")) - (assert (test-print-arglist '(x &aux y z) "(x)")) - (assert (test-print-arglist '(x &environment env y) "(x y)"))) -;; Expected failure: -;; (assert (test-print-arglist '(&key ((function f))) "(&key ((function f)))")) - (defslimefun variable-desc-for-echo-area (variable-name) "Return a short description of VARIABLE-NAME, or NIL." (with-buffer-syntax () @@ -2012,6 +1992,26 @@ (longest-completion completion-set))))))) +(defun arglist-to-string (arglist package &key print-right-margin highlight) + (decoded-arglist-to-string (decode-arglist arglist) + package + :print-right-margin print-right-margin + :highlight highlight)) + +(defun test-print-arglist (list string) + (string= (arglist-to-string list (find-package :swank)) string)) + +;; Should work: +(progn + (assert (test-print-arglist '(function cons) "(function cons)")) + (assert (test-print-arglist '(quote cons) "(quote cons)")) + (assert (test-print-arglist '(&key (function #'+)) "(&key (function #'+))")) + (assert (test-print-arglist '(&whole x y z) "(y z)")) + (assert (test-print-arglist '(x &aux y z) "(x)")) + (assert (test-print-arglist '(x &environment env y) "(x y)"))) +;; Expected failure: +;; (assert (test-print-arglist '(&key ((function f))) "(&key ((function f)))")) + ;;;; Recording and accessing results of computations From mkoeppe at common-lisp.net Sun Mar 26 21:19:54 2006 From: mkoeppe at common-lisp.net (mkoeppe) Date: Sun, 26 Mar 2006 16:19:54 -0500 (EST) Subject: [slime-cvs] CVS slime Message-ID: <20060326211954.1B48B5300F@common-lisp.net> Update of /project/slime/cvsroot/slime In directory clnet:/tmp/cvs-serv6248 Modified Files: slime.el Log Message: (slime-enclosing-operator-names): Fix for situation when point is at end of buffer, as it happens often in the REPL. --- /project/slime/cvsroot/slime/slime.el 2006/03/26 03:51:56 1.605 +++ /project/slime/cvsroot/slime/slime.el 2006/03/26 21:19:53 1.606 @@ -10046,7 +10046,8 @@ (<= level max-levels)) (let ((arg-index 0)) ;; Move to the beginning of the current sexp if not already there. - (if (or (member (char-syntax (char-after)) '(?\( ?')) + (if (or (and (char-after) + (member (char-syntax (char-after)) '(?\( ?'))) (member (char-syntax (char-before)) '(?\ ?>))) (incf arg-index)) (ignore-errors From mkoeppe at common-lisp.net Sun Mar 26 21:20:15 2006 From: mkoeppe at common-lisp.net (mkoeppe) Date: Sun, 26 Mar 2006 16:20:15 -0500 (EST) Subject: [slime-cvs] CVS slime Message-ID: <20060326212015.50E89650A1@common-lisp.net> Update of /project/slime/cvsroot/slime In directory clnet:/tmp/cvs-serv6376 Modified Files: ChangeLog Log Message: *** empty log message *** --- /project/slime/cvsroot/slime/ChangeLog 2006/03/26 03:58:16 1.871 +++ /project/slime/cvsroot/slime/ChangeLog 2006/03/26 21:20:15 1.872 @@ -1,3 +1,8 @@ +2006-03-26 Matthias Koeppe + + * slime.el (slime-enclosing-operator-names): Fix for situation + when point is at end of buffer, as it happens often in the REPL. + 2006-03-25 Matthias Koeppe * swank.lisp (arglist-for-echo-area): New keyword arg, From mkoeppe at common-lisp.net Mon Mar 27 07:14:32 2006 From: mkoeppe at common-lisp.net (mkoeppe) Date: Mon, 27 Mar 2006 02:14:32 -0500 (EST) Subject: [slime-cvs] CVS slime Message-ID: <20060327071432.AD7F46200A@common-lisp.net> Update of /project/slime/cvsroot/slime In directory clnet:/tmp/cvs-serv1447 Modified Files: slime.el Log Message: (slime-hyperspec-lookup): Don't get confused by a cl: or common-lisp: package prefix. --- /project/slime/cvsroot/slime/slime.el 2006/03/26 21:19:53 1.606 +++ /project/slime/cvsroot/slime/slime.el 2006/03/27 07:14:32 1.607 @@ -6924,15 +6924,20 @@ (defun slime-hyperspec-lookup (symbol-name) "A wrapper for `hyperspec-lookup'" - (interactive (list (let ((symbol-at-point (slime-symbol-name-at-point))) - (if (and symbol-at-point - (intern-soft (downcase symbol-at-point) + (interactive (list (let* ((symbol-at-point (slime-symbol-name-at-point)) + (stripped-symbol + (and symbol-at-point + (downcase + (common-lisp-hyperspec-strip-cl-package + symbol-at-point))))) + (if (and stripped-symbol + (intern-soft stripped-symbol common-lisp-hyperspec-symbols)) - symbol-at-point + stripped-symbol (completing-read "Look up symbol in Common Lisp HyperSpec: " common-lisp-hyperspec-symbols #'boundp - t symbol-at-point + t stripped-symbol 'common-lisp-hyperspec-history))))) (hyperspec-lookup symbol-name)) From mkoeppe at common-lisp.net Mon Mar 27 07:15:58 2006 From: mkoeppe at common-lisp.net (mkoeppe) Date: Mon, 27 Mar 2006 02:15:58 -0500 (EST) Subject: [slime-cvs] CVS slime Message-ID: <20060327071558.2247267170@common-lisp.net> Update of /project/slime/cvsroot/slime In directory clnet:/tmp/cvs-serv2843 Modified Files: ChangeLog Log Message: *** empty log message *** --- /project/slime/cvsroot/slime/ChangeLog 2006/03/26 21:20:15 1.872 +++ /project/slime/cvsroot/slime/ChangeLog 2006/03/27 07:15:57 1.873 @@ -1,3 +1,13 @@ +2006-03-27 Matthias Koeppe + + * hyperspec.el (common-lisp-hyperspec-strip-cl-package): New + function. + (common-lisp-hyperspec): Don't get confused by a cl: or + common-lisp: package prefix. + + * slime.el (slime-hyperspec-lookup): Don't get confused by a cl: + or common-lisp: package prefix. + 2006-03-26 Matthias Koeppe * slime.el (slime-enclosing-operator-names): Fix for situation From mbaringer at common-lisp.net Mon Mar 27 08:57:58 2006 From: mbaringer at common-lisp.net (mbaringer) Date: Mon, 27 Mar 2006 03:57:58 -0500 (EST) Subject: [slime-cvs] CVS /slime Message-ID: <20060327085758.6A8AB4B00F@common-lisp.net> Update of /project/slime/cvsroot//slime In directory clnet:/tmp/cvs-serv12776 Modified Files: ChangeLog Log Message: --- /project/slime/cvsroot//slime/ChangeLog 2006/03/27 07:15:57 1.873 +++ /project/slime/cvsroot//slime/ChangeLog 2006/03/27 08:57:57 1.874 @@ -1,3 +1,11 @@ +2006-03-27 Marco Baringer + + * slime.el (slime-make-tramp-file-name): If emcas' tramp has + tramp-multi-methods then pass the method parameter to + tramp-make-tramp-file-name, otherwise don't. + (slime-create-filename-translator): Use + slime-make-tramp-file-name. + 2006-03-27 Matthias Koeppe * hyperspec.el (common-lisp-hyperspec-strip-cl-package): New From mbaringer at common-lisp.net Mon Mar 27 08:58:29 2006 From: mbaringer at common-lisp.net (mbaringer) Date: Mon, 27 Mar 2006 03:58:29 -0500 (EST) Subject: [slime-cvs] CVS /slime Message-ID: <20060327085829.F22834B011@common-lisp.net> Update of /project/slime/cvsroot//slime In directory clnet:/tmp/cvs-serv12823 Modified Files: slime.el Log Message: (slime-make-tramp-file-name): If emcas' tramp has tramp-multi-methods then pass the method parameter to tramp-make-tramp-file-name, otherwise don't. (slime-create-filename-translator): Use slime-make-tramp-file-name. --- /project/slime/cvsroot//slime/slime.el 2006/03/27 07:14:32 1.607 +++ /project/slime/cvsroot//slime/slime.el 2006/03/27 08:58:29 1.608 @@ -1283,6 +1283,18 @@ (slime-machine-instance))) filename)) +(defun slime-make-tramp-file-name (username remote-host lisp-filename) + "Old (with multi-hops) tramp compatability function" + (if (boundp 'tramp-multi-methods) + (tramp-make-tramp-file-name nil nil + username + remote-host + lisp-filename) + (tramp-make-tramp-file-name nil + username + remote-host + lisp-filename))) + (defun* slime-create-filename-translator (&key machine-instance remote-host username) @@ -1306,7 +1318,7 @@ (tramp-file-name-localname (tramp-dissect-file-name emacs-filename))) `(lambda (lisp-filename) - (tramp-make-tramp-file-name nil + (slime-make-tramp-file-name ,username ,remote-host lisp-filename))))) From mkoeppe at common-lisp.net Tue Mar 28 00:30:31 2006 From: mkoeppe at common-lisp.net (mkoeppe) Date: Mon, 27 Mar 2006 19:30:31 -0500 (EST) Subject: [slime-cvs] CVS slime Message-ID: <20060328003031.08A61111C7@common-lisp.net> Update of /project/slime/cvsroot/slime In directory clnet:/tmp/cvs-serv5728 Modified Files: hyperspec.el Log Message: (common-lisp-hyperspec-strip-cl-package): New function. (common-lisp-hyperspec): Don't get confused by a cl: or common-lisp: package prefix. --- /project/slime/cvsroot/slime/hyperspec.el 2004/09/15 11:29:27 1.7 +++ /project/slime/cvsroot/slime/hyperspec.el 2006/03/28 00:30:31 1.8 @@ -60,6 +60,16 @@ (defvar common-lisp-hyperspec-symbols (make-vector 67 0)) +(defun common-lisp-hyperspec-strip-cl-package (name) + (if (string-match "^\\([^:]*\\)::?\\([^:]*\\)$" name) + (let ((package-name (match-string 1 name)) + (symbol-name (match-string 2 name))) + (if (member (downcase package-name) + '("cl" "common-lisp")) + symbol-name + name)) + name)) + (defun common-lisp-hyperspec (symbol-name) "View the documentation on SYMBOL-NAME from the Common Lisp HyperSpec. If SYMBOL-NAME has more than one definition, all of them are displayed with @@ -73,22 +83,29 @@ Visit http://www.lispworks.com/reference/HyperSpec/ for more information. If you copy the HyperSpec to another location, customize the variable `common-lisp-hyperspec-root' to point to that location." - (interactive (list (let ((symbol-at-point (thing-at-point 'symbol))) - (if (and symbol-at-point - (intern-soft (downcase symbol-at-point) + (interactive (list (let* ((symbol-at-point (thing-at-point 'symbol)) + (stripped-symbol + (and symbol-at-point + (downcase + (common-lisp-hyperspec-strip-cl-package + symbol-at-point))))) + (if (and stripped-symbol + (intern-soft stripped-symbol common-lisp-hyperspec-symbols)) - symbol-at-point + stripped-symbol (completing-read "Look up symbol in Common Lisp HyperSpec: " common-lisp-hyperspec-symbols #'boundp - t symbol-at-point + t stripped-symbol 'common-lisp-hyperspec-history))))) (maplist (lambda (entry) (browse-url (concat common-lisp-hyperspec-root "Body/" (car entry))) (if (cdr entry) (sleep-for 1.5))) - (let ((symbol (intern-soft (downcase symbol-name) - common-lisp-hyperspec-symbols))) + (let ((symbol (intern-soft + (common-lisp-hyperspec-strip-cl-package + (downcase symbol-name)) + common-lisp-hyperspec-symbols))) (if (and symbol (boundp symbol)) (symbol-value symbol) (error "The symbol `%s' is not defined in Common Lisp" From mkoeppe at common-lisp.net Tue Mar 28 00:41:41 2006 From: mkoeppe at common-lisp.net (mkoeppe) Date: Mon, 27 Mar 2006 19:41:41 -0500 (EST) Subject: [slime-cvs] CVS slime Message-ID: <20060328004141.6E1FE15001@common-lisp.net> Update of /project/slime/cvsroot/slime In directory clnet:/tmp/cvs-serv7490 Modified Files: swank.lisp Log Message: (operator-designator-to-form): Handle forms similar to make-instance (make-condition, error, etc.) (extra-keywords/make-instance): New function. (extra-keywords): Specialize on operators make-condition, error, signal, warn, cerror. --- /project/slime/cvsroot/slime/swank.lisp 2006/03/26 04:24:04 1.373 +++ /project/slime/cvsroot/slime/swank.lisp 2006/03/28 00:41:41 1.374 @@ -1408,9 +1408,10 @@ (etypecase name (cons (destructure-case name - ((:make-instance class-name) - (values `(make-instance ',(parse-symbol class-name)) - 'make-instance)) + ((:make-instance class-name operator-name) + (let ((parsed-operator-name (parse-symbol operator-name))) + (values `(,parsed-operator-name ',(parse-symbol class-name)) + operator-name))) ((:defmethod generic-name) (values `(defmethod ,(parse-symbol generic-name)) 'defmethod)))) @@ -1758,8 +1759,8 @@ (generic-function-keywords symbol-function) nil))) -(defmethod extra-keywords ((operator (eql 'make-instance)) - &rest args) +(defun extra-keywords/make-instance (operator &rest args) + (declare (ignore operator)) (unless (null args) (let ((class-name-form (car args))) (when (and (listp class-name-form) @@ -1792,12 +1793,42 @@ (initialize-instance-keywords (applicable-methods-keywords #'initialize-instance (list class)))) - (return-from extra-keywords + (return-from extra-keywords/make-instance (values (append slot-init-keywords initialize-instance-keywords) allow-other-keys-p - (list class-name-form)))))))))) - (call-next-method)) + (list class-name-form))))))))))) + +(defmethod extra-keywords ((operator (eql 'make-instance)) + &rest args) + (or (apply #'extra-keywords/make-instance operator args) + (call-next-method))) + +(defmethod extra-keywords ((operator (eql 'make-condition)) + &rest args) + (or (apply #'extra-keywords/make-instance operator args) + (call-next-method))) + +(defmethod extra-keywords ((operator (eql 'error)) + &rest args) + (or (apply #'extra-keywords/make-instance operator args) + (call-next-method))) + +(defmethod extra-keywords ((operator (eql 'signal)) + &rest args) + (or (apply #'extra-keywords/make-instance operator args) + (call-next-method))) + +(defmethod extra-keywords ((operator (eql 'warn)) + &rest args) + (or (apply #'extra-keywords/make-instance operator args) + (call-next-method))) + +(defmethod extra-keywords ((operator (eql 'cerror)) + &rest args) + (or (apply #'extra-keywords/make-instance operator + (cdr args)) + (call-next-method))) (defun enrich-decoded-arglist-with-extra-keywords (decoded-arglist form) "Determine extra keywords from the function call FORM, and modify From mkoeppe at common-lisp.net Tue Mar 28 00:43:16 2006 From: mkoeppe at common-lisp.net (mkoeppe) Date: Mon, 27 Mar 2006 19:43:16 -0500 (EST) Subject: [slime-cvs] CVS slime Message-ID: <20060328004316.D473818005@common-lisp.net> Update of /project/slime/cvsroot/slime In directory clnet:/tmp/cvs-serv7538 Modified Files: slime.el Log Message: (slime-enclosing-operator-names): Handle forms similar to make-instance (make-condition, error, etc.), to get extra keywords based on the condition class. --- /project/slime/cvsroot/slime/slime.el 2006/03/27 08:58:29 1.608 +++ /project/slime/cvsroot/slime/slime.el 2006/03/28 00:43:16 1.609 @@ -10079,21 +10079,24 @@ (when-let (name (slime-symbol-name-at-point)) ;; Detect MAKE-INSTANCE forms and collect the class-name ;; if exists and is a quoted symbol. - (ignore-errors - (cond - ((member (upcase name) '("MAKE-INSTANCE" - "CL:MAKE-INSTANCE")) - (forward-char (1+ (length name))) - (slime-forward-blanks) - (let ((str (slime-sexp-at-point))) - (when (= (aref str 0) ?') - (setq name (list :make-instance (substring str 1)))))) - ((member (upcase name) '("DEFMETHOD" - "CL:DEFMETHOD")) - (forward-char (1+ (length name))) - (slime-forward-blanks) - (let ((str (slime-sexp-at-point))) - (setq name (list :defmethod str)))))) + (let ((symbol-name (upcase (slime-cl-symbol-name name))) + (package (upcase (slime-cl-symbol-package name)))) + (ignore-errors + (cond + ((member symbol-name + '("MAKE-INSTANCE" "MAKE-CONDITION" + "ERROR" "SIGNAL" "WARN")) + (forward-char (1+ (length name))) + (slime-forward-blanks) + (let ((str (slime-sexp-at-point))) + (when (= (aref str 0) ?') + (setq name (list :make-instance (substring str 1) + name))))) + ((member symbol-name '("DEFMETHOD")) + (forward-char (1+ (length name))) + (slime-forward-blanks) + (let ((str (slime-sexp-at-point))) + (setq name (list :defmethod str))))))) (push name result) (push arg-index arg-indices)) (backward-up-list 1))))))) From mkoeppe at common-lisp.net Tue Mar 28 04:38:45 2006 From: mkoeppe at common-lisp.net (mkoeppe) Date: Mon, 27 Mar 2006 23:38:45 -0500 (EST) Subject: [slime-cvs] CVS slime Message-ID: <20060328043845.3E7335C11E@common-lisp.net> Update of /project/slime/cvsroot/slime In directory clnet:/tmp/cvs-serv8053 Modified Files: ChangeLog Log Message: --- /project/slime/cvsroot/slime/ChangeLog 2006/03/27 08:57:57 1.874 +++ /project/slime/cvsroot/slime/ChangeLog 2006/03/28 04:38:45 1.875 @@ -1,3 +1,15 @@ +2006-03-28 Matthias Koeppe + + * slime.el (slime-enclosing-operator-names): Handle forms similar + to make-instance (make-condition, error, etc.), to get extra + keywords based on the condition class. + + * swank.lisp (operator-designator-to-form): Handle forms similar + to make-instance (make-condition, error, etc.) + (extra-keywords/make-instance): New function. + (extra-keywords): Specialize on operators make-condition, error, + signal, warn, cerror. + 2006-03-27 Marco Baringer * slime.el (slime-make-tramp-file-name): If emcas' tramp has From mkoeppe at common-lisp.net Tue Mar 28 20:05:16 2006 From: mkoeppe at common-lisp.net (mkoeppe) Date: Tue, 28 Mar 2006 15:05:16 -0500 (EST) Subject: [slime-cvs] CVS slime Message-ID: <20060328200516.8E8CB6200A@common-lisp.net> Update of /project/slime/cvsroot/slime In directory clnet:/tmp/cvs-serv30290 Modified Files: slime.el Log Message: (slime-enclosing-operator-names): Fix last change. --- /project/slime/cvsroot/slime/slime.el 2006/03/28 00:43:16 1.609 +++ /project/slime/cvsroot/slime/slime.el 2006/03/28 20:05:16 1.610 @@ -10079,8 +10079,7 @@ (when-let (name (slime-symbol-name-at-point)) ;; Detect MAKE-INSTANCE forms and collect the class-name ;; if exists and is a quoted symbol. - (let ((symbol-name (upcase (slime-cl-symbol-name name))) - (package (upcase (slime-cl-symbol-package name)))) + (let ((symbol-name (upcase (slime-cl-symbol-name name)))) (ignore-errors (cond ((member symbol-name From mkoeppe at common-lisp.net Tue Mar 28 20:12:07 2006 From: mkoeppe at common-lisp.net (mkoeppe) Date: Tue, 28 Mar 2006 15:12:07 -0500 (EST) Subject: [slime-cvs] CVS slime Message-ID: <20060328201207.07A985082@common-lisp.net> Update of /project/slime/cvsroot/slime In directory clnet:/tmp/cvs-serv30641 Modified Files: slime.el Log Message: (slime-recently-visited-buffer): Ignore internal buffers (starting with a space), to avoid selecting the *slime-fontify* buffer. Reported by Andreas Fuchs. --- /project/slime/cvsroot/slime/slime.el 2006/03/28 20:05:16 1.610 +++ /project/slime/cvsroot/slime/slime.el 2006/03/28 20:12:06 1.611 @@ -8966,6 +8966,7 @@ Only considers buffers that are not already visible." (loop for buffer in (buffer-list) when (and (with-current-buffer buffer (eq major-mode mode)) + (not (string-match "^ " (buffer-name buffer))) (null (get-buffer-window buffer 'visible))) return buffer finally (error "Can't find unshown buffer in %S" mode))) From mkoeppe at common-lisp.net Tue Mar 28 20:41:53 2006 From: mkoeppe at common-lisp.net (mkoeppe) Date: Tue, 28 Mar 2006 15:41:53 -0500 (EST) Subject: [slime-cvs] CVS slime Message-ID: <20060328204153.EC13F7A000@common-lisp.net> Update of /project/slime/cvsroot/slime In directory clnet:/tmp/cvs-serv1641 Modified Files: swank.lisp Log Message: (multiple-value-or): New macro. (extra-keywords): Use MULTIPLE-VALUE-OR rather than OR. --- /project/slime/cvsroot/slime/swank.lisp 2006/03/28 00:41:41 1.374 +++ /project/slime/cvsroot/slime/swank.lisp 2006/03/28 20:41:53 1.375 @@ -1799,36 +1799,47 @@ allow-other-keys-p (list class-name-form))))))))))) +(defmacro multiple-value-or (&rest forms) + (if (null forms) + nil + (let ((first (first forms)) + (rest (rest forms))) + `(let* ((values (multiple-value-list ,first)) + (primary-value (first values))) + (if primary-value + (values-list values) + (multiple-value-or , at rest)))))) + (defmethod extra-keywords ((operator (eql 'make-instance)) &rest args) - (or (apply #'extra-keywords/make-instance operator args) - (call-next-method))) + (multiple-value-or (apply #'extra-keywords/make-instance operator args) + (call-next-method))) (defmethod extra-keywords ((operator (eql 'make-condition)) &rest args) - (or (apply #'extra-keywords/make-instance operator args) - (call-next-method))) + (multiple-value-or (apply #'extra-keywords/make-instance operator args) + (call-next-method))) (defmethod extra-keywords ((operator (eql 'error)) &rest args) - (or (apply #'extra-keywords/make-instance operator args) - (call-next-method))) + (multiple-value-or (apply #'extra-keywords/make-instance operator args) + (call-next-method))) (defmethod extra-keywords ((operator (eql 'signal)) &rest args) - (or (apply #'extra-keywords/make-instance operator args) - (call-next-method))) + (multiple-value-or (apply #'extra-keywords/make-instance operator args) + (call-next-method))) (defmethod extra-keywords ((operator (eql 'warn)) &rest args) - (or (apply #'extra-keywords/make-instance operator args) - (call-next-method))) + (multiple-value-or (apply #'extra-keywords/make-instance operator args) + (call-next-method))) (defmethod extra-keywords ((operator (eql 'cerror)) &rest args) - (or (apply #'extra-keywords/make-instance operator - (cdr args)) - (call-next-method))) + (multiple-value-or (apply #'extra-keywords/make-instance operator + (cdr args)) + (call-next-method))) (defun enrich-decoded-arglist-with-extra-keywords (decoded-arglist form) "Determine extra keywords from the function call FORM, and modify From mkoeppe at common-lisp.net Tue Mar 28 20:44:33 2006 From: mkoeppe at common-lisp.net (mkoeppe) Date: Tue, 28 Mar 2006 15:44:33 -0500 (EST) Subject: [slime-cvs] CVS slime Message-ID: <20060328204433.CEB787A000@common-lisp.net> Update of /project/slime/cvsroot/slime In directory clnet:/tmp/cvs-serv1702 Modified Files: ChangeLog Log Message: *** empty log message *** --- /project/slime/cvsroot/slime/ChangeLog 2006/03/28 04:38:45 1.875 +++ /project/slime/cvsroot/slime/ChangeLog 2006/03/28 20:44:33 1.876 @@ -1,5 +1,11 @@ 2006-03-28 Matthias Koeppe + * swank.lisp (multiple-value-or): New macro. + + * slime.el (slime-recently-visited-buffer): Ignore internal + buffers (starting with a space), to avoid selecting the + *slime-fontify* buffer. Reported by Andreas Fuchs. + * slime.el (slime-enclosing-operator-names): Handle forms similar to make-instance (make-condition, error, etc.), to get extra keywords based on the condition class. @@ -8,7 +14,7 @@ to make-instance (make-condition, error, etc.) (extra-keywords/make-instance): New function. (extra-keywords): Specialize on operators make-condition, error, - signal, warn, cerror. + signal, warn, cerror. Use multiple-value-or. 2006-03-27 Marco Baringer From mkoeppe at common-lisp.net Wed Mar 29 22:36:13 2006 From: mkoeppe at common-lisp.net (mkoeppe) Date: Wed, 29 Mar 2006 17:36:13 -0500 (EST) Subject: [slime-cvs] CVS slime Message-ID: <20060329223613.05AFD12034@common-lisp.net> Update of /project/slime/cvsroot/slime In directory clnet:/tmp/cvs-serv22067 Modified Files: slime.el Log Message: (slime-repl-mode): Enable autodoc-mode if slime-use-autodoc-mode is true. --- /project/slime/cvsroot/slime/slime.el 2006/03/28 20:12:06 1.611 +++ /project/slime/cvsroot/slime/slime.el 2006/03/29 22:36:13 1.612 @@ -3040,6 +3040,8 @@ (add-hook 'kill-buffer-hook 'slime-repl-safe-save-merged-history nil t) (add-hook 'kill-emacs-hook 'slime-repl-save-all-histories) (slime-setup-command-hooks) + (when slime-use-autodoc-mode + (slime-autodoc-mode 1)) (run-hooks 'slime-repl-mode-hook)) (defun slime-presentation-whole-p (presentation start end &optional object) From mkoeppe at common-lisp.net Wed Mar 29 22:36:38 2006 From: mkoeppe at common-lisp.net (mkoeppe) Date: Wed, 29 Mar 2006 17:36:38 -0500 (EST) Subject: [slime-cvs] CVS slime Message-ID: <20060329223638.4985F18003@common-lisp.net> Update of /project/slime/cvsroot/slime In directory clnet:/tmp/cvs-serv22119 Modified Files: ChangeLog Log Message: --- /project/slime/cvsroot/slime/ChangeLog 2006/03/28 20:44:33 1.876 +++ /project/slime/cvsroot/slime/ChangeLog 2006/03/29 22:36:38 1.877 @@ -1,3 +1,8 @@ +2006-03-29 Matthias Koeppe + + * slime.el (slime-repl-mode): Enable autodoc-mode if + slime-use-autodoc-mode is true. + 2006-03-28 Matthias Koeppe * swank.lisp (multiple-value-or): New macro. From heller at common-lisp.net Thu Mar 30 16:38:59 2006 From: heller at common-lisp.net (heller) Date: Thu, 30 Mar 2006 11:38:59 -0500 (EST) Subject: [slime-cvs] CVS slime Message-ID: <20060330163859.2709F20012@common-lisp.net> Update of /project/slime/cvsroot/slime In directory clnet:/tmp/cvs-serv27902 Modified Files: slime.el Log Message: (slime-macroexpansion-minor-mode): Make it Emacs 20 compatible. (slime-init-command): Don't translate filenames since the new scheme doesn't work without a connection. (slime-to-lisp-filename,slime-from-lisp-filename): Remove some redundancy. --- /project/slime/cvsroot/slime/slime.el 2006/03/29 22:36:13 1.612 +++ /project/slime/cvsroot/slime/slime.el 2006/03/30 16:38:54 1.613 @@ -1256,32 +1256,18 @@ (defun slime-to-lisp-filename (filename) "Translate the string FILENAME to a Lisp filename. See `slime-filename-translations'." - (if (slime-connected-p) - (block slime-to-lisp-filename - (dolist (translation-spec slime-filename-translations) - (let ((hostname-regexp (car translation-spec)) - (to-lisp (second translation-spec))) - (when (string-match hostname-regexp (slime-machine-instance)) - (return-from slime-to-lisp-filename (funcall to-lisp (expand-file-name filename)))))) - (error "No elements in slime-filename-translations (%S) matched the connection's hostname (%S)" - slime-filename-translations - (slime-machine-instance))) - filename)) + (funcall (first (slime-find-filename-translators (slime-machine-instance))) + (expand-file-name filename))) (defun slime-from-lisp-filename (filename) "Translate the Lisp filename FILENAME to an Emacs filename. See `slime-filename-translations'." - (if (slime-connected-p) - (block slime-from-lisp-filename - (dolist (translation-spec slime-filename-translations) - (let ((hostname-regexp (car translation-spec)) - (from-lisp (third translation-spec))) - (when (string-match hostname-regexp (slime-machine-instance)) - (return-from slime-from-lisp-filename (funcall from-lisp filename))))) - (error "No elements in slime-filename-translations (%S) matched the connection's hostname (%S)" - slime-filename-translations - (slime-machine-instance))) - filename)) + (funcall (second (slime-find-filename-translators (slime-machine-instance))) + filename)) + +(defun slime-find-filename-translators (hostname) + (or (assoc-default hostname slime-filename-translations) + (error "No filename-translations for hostname: %s" hostname))) (defun slime-make-tramp-file-name (username remote-host lisp-filename) "Old (with multi-hops) tramp compatability function" @@ -1577,18 +1563,16 @@ (with-current-buffer (process-buffer process) slime-inferior-lisp-args)) -;; XXX load-server & start-server used to separated. maybe that was better. +;; XXX load-server & start-server used to be separated. maybe that was better. (defun slime-init-command (port-filename coding-system) "Return a string to initialize Lisp." - (let ((loader - (slime-to-lisp-filename (if (file-name-absolute-p slime-backend) - slime-backend - (concat slime-path slime-backend)))) - (encoding (slime-coding-system-cl-name coding-system)) - (filename (slime-to-lisp-filename port-filename))) + (let ((loader (if (file-name-absolute-p slime-backend) + slime-backend + (concat slime-path slime-backend))) + (encoding (slime-coding-system-cl-name coding-system))) (format "%S\n%S\n\n" `(load ,loader :verbose t) - `(swank:start-server ,filename :external-format ,encoding)))) + `(swank:start-server ,port-filename :external-format ,encoding)))) (defun slime-swank-port-file () "Filename where the SWANK server writes its TCP port number." @@ -7335,14 +7319,13 @@ nil " temp" '(("q" . slime-temp-buffer-quit) - ("g" . slime-macroexpand-again)) - (flet ((remap (from to) - (dolist (mapping (where-is-internal from slime-mode-map)) - (define-key slime-macroexpansion-minor-mode-map - mapping - to)))) - (remap 'slime-macroexpand-1 'slime-macroexpand-1-inplace) - (remap 'slime-macroexpand-all 'slime-macroexpand-all-inplace))) + ("g" . slime-macroexpand-again))) + +(flet ((remap (from to) + (dolist (mapping (where-is-internal from slime-mode-map)) + (define-key slime-macroexpansion-minor-mode-map mapping to)))) + (remap 'slime-macroexpand-1 'slime-macroexpand-1-inplace) + (remap 'slime-macroexpand-all 'slime-macroexpand-all-inplace)) (defvar slime-eval-macroexpand-expression nil "Specifies the last macroexpansion preformed. This variable From heller at common-lisp.net Thu Mar 30 16:41:52 2006 From: heller at common-lisp.net (heller) Date: Thu, 30 Mar 2006 11:41:52 -0500 (EST) Subject: [slime-cvs] CVS slime Message-ID: <20060330164152.3E3664C001@common-lisp.net> Update of /project/slime/cvsroot/slime In directory clnet:/tmp/cvs-serv28798 Modified Files: slime.el Log Message: (slime-find-filename-translators): Use string-match. --- /project/slime/cvsroot/slime/slime.el 2006/03/30 16:38:54 1.613 +++ /project/slime/cvsroot/slime/slime.el 2006/03/30 16:41:52 1.614 @@ -1266,7 +1266,7 @@ filename)) (defun slime-find-filename-translators (hostname) - (or (assoc-default hostname slime-filename-translations) + (or (assoc-default hostname slime-filename-translations #'string-match) (error "No filename-translations for hostname: %s" hostname))) (defun slime-make-tramp-file-name (username remote-host lisp-filename) From heller at common-lisp.net Thu Mar 30 16:42:14 2006 From: heller at common-lisp.net (heller) Date: Thu, 30 Mar 2006 11:42:14 -0500 (EST) Subject: [slime-cvs] CVS slime Message-ID: <20060330164214.47DA24E005@common-lisp.net> Update of /project/slime/cvsroot/slime In directory clnet:/tmp/cvs-serv28826 Modified Files: ChangeLog Log Message: *** empty log message *** --- /project/slime/cvsroot/slime/ChangeLog 2006/03/29 22:36:38 1.877 +++ /project/slime/cvsroot/slime/ChangeLog 2006/03/30 16:42:14 1.878 @@ -1,3 +1,11 @@ +2006-03-30 Helmut Eller + + * slime.el (slime-init-command): Don't translate filenames since + the new scheme doesn't work without a connection. + (slime-to-lisp-filename,slime-from-lisp-filename): Remove some + redundancy. + (slime-macroexpansion-minor-mode): Make it Emacs 20 compatible. + 2006-03-29 Matthias Koeppe * slime.el (slime-repl-mode): Enable autodoc-mode if