From trittweiler at common-lisp.net  Fri Apr  3 20:43:12 2009
From: trittweiler at common-lisp.net (CVS User trittweiler)
Date: Fri, 03 Apr 2009 16:43:12 -0400
Subject: [slime-cvs] CVS slime
Message-ID: <E1LpqEK-00050A-02@common-lisp.net>

Update of /project/slime/cvsroot/slime
In directory cl-net:/tmp/cvs-serv19220

Modified Files:
	slime.el ChangeLog 
Log Message:
	* slime.el (slime-inspector-mode-map): Remove binding for
	M-RET. (It'll be added by the slime-repl contrib.)
	(slime-inspector-copy-down): Removed.


--- /project/slime/cvsroot/slime/slime.el	2009/03/27 20:49:41	1.1151
+++ /project/slime/cvsroot/slime/slime.el	2009/04/03 20:43:11	1.1152
@@ -6365,13 +6365,6 @@
           (t
            (error "No clickable part here")))))
 
-;; (defun slime-inspector-copy-down (number)
-;;   "Evaluate the slot at point via the REPL (to set `*')."
-;;   (interactive (list (or (get-text-property (point) 'slime-part-number)
-;;                          (error "No part at point"))))
-;;   (slime-repl-send-string (format "%s" `(swank:inspector-nth-part ,number)))
-;;   (slime-repl))
-
 (defun slime-inspector-pop ()
   (interactive)
   (slime-eval-async 
@@ -6541,7 +6534,6 @@
 
 (slime-define-keys slime-inspector-mode-map
   ([return] 'slime-inspector-operate-on-point)
-  ((kbd "M-RET") 'slime-inspector-copy-down)
   ("\C-m"   'slime-inspector-operate-on-point)
   ([mouse-2] 'slime-inspector-operate-on-click)
   ("l" 'slime-inspector-pop)
--- /project/slime/cvsroot/slime/ChangeLog	2009/03/27 20:49:49	1.1723
+++ /project/slime/cvsroot/slime/ChangeLog	2009/04/03 20:43:11	1.1724
@@ -1,3 +1,9 @@
+2009-04-03  Tobias C. Rittweiler  <tcr at freebits.de>
+
+	* slime.el (slime-inspector-mode-map): Remove binding for
+	M-RET. (It'll be added by the slime-repl contrib.)
+	(slime-inspector-copy-down): Removed.
+
 2009-03-27  Helmut Eller  <heller at common-lisp.net>
 
 	* swank.lisp (encode-message): Handle errors during write, e.g.




From trittweiler at common-lisp.net  Fri Apr  3 20:43:48 2009
From: trittweiler at common-lisp.net (CVS User trittweiler)
Date: Fri, 03 Apr 2009 16:43:48 -0400
Subject: [slime-cvs] CVS slime/contrib
Message-ID: <E1LpqEu-00050v-Gp@common-lisp.net>

Update of /project/slime/cvsroot/slime/contrib
In directory cl-net:/tmp/cvs-serv19273/contrib

Modified Files:
	slime-repl.el ChangeLog 
Log Message:
	* slime-repl.el (slime-inspector-mode-map): Add binding for M-RET.
	(slime-inspector-copy-down-to-repl): Moved here from slime.el.


--- /project/slime/cvsroot/slime/contrib/slime-repl.el	2009/03/27 12:58:22	1.19
+++ /project/slime/cvsroot/slime/contrib/slime-repl.el	2009/04/03 20:43:48	1.20
@@ -458,6 +458,9 @@
   ("\C-c\C-p" 'slime-repl-previous-prompt)
   ("\C-c\C-z" 'slime-nop))
 
+(slime-define-keys slime-inspector-mode-map
+  ((kbd "M-RET") 'slime-inspector-copy-down-to-repl))
+
 (def-slime-selector-method ?r
   "SLIME Read-Eval-Print-Loop."
   (slime-output-buffer))
@@ -1417,6 +1420,14 @@
             (t
              (error "Not in a function definition")))))))
 
+(defun slime-inspector-copy-down-to-repl (number)
+   "Evaluate the inspector slot at point via the REPL (to set `*')."
+   (interactive (list (or (get-text-property (point) 'slime-part-number)
+                          (error "No part at point"))))
+   (slime-repl-send-string (format "%s" `(swank:inspector-nth-part ,number)))
+   (slime-repl))
+
+
 (defun slime-set-default-directory (directory)
   "Make DIRECTORY become Lisp's current directory."
   (interactive (list (read-directory-name "Directory: " nil nil t)))
--- /project/slime/cvsroot/slime/contrib/ChangeLog	2009/03/27 20:33:25	1.198
+++ /project/slime/cvsroot/slime/contrib/ChangeLog	2009/04/03 20:43:48	1.199
@@ -1,3 +1,8 @@
+2009-04-03  Tobias C. Rittweiler  <tcr at freebits.de>
+
+	* slime-repl.el (slime-inspector-mode-map): Add binding for M-RET.
+	(slime-inspector-copy-down-to-repl): Moved here from slime.el.
+
 2009-03-27  Tobias C. Rittweiler  <tcr at freebits.de>
 
 	* slime-indentantion-fu.el (slime-indent-fu): Correctly deal with




From trittweiler at common-lisp.net  Fri Apr  3 21:13:00 2009
From: trittweiler at common-lisp.net (CVS User trittweiler)
Date: Fri, 03 Apr 2009 17:13:00 -0400
Subject: [slime-cvs] CVS slime
Message-ID: <E1LpqhA-000631-F6@common-lisp.net>

Update of /project/slime/cvsroot/slime
In directory cl-net:/tmp/cvs-serv23245

Modified Files:
	ChangeLog swank-sbcl.lisp 
Log Message:
	* swank-sbcl.lisp (swank-compile-file): Return T for the FAILURE-P
	return value in case of a FATA-COMPILER-ERROR.


--- /project/slime/cvsroot/slime/ChangeLog	2009/04/03 20:43:11	1.1724
+++ /project/slime/cvsroot/slime/ChangeLog	2009/04/03 21:13:00	1.1725
@@ -1,5 +1,12 @@
 2009-04-03  Tobias C. Rittweiler  <tcr at freebits.de>
 
+	* swank-sbcl.lisp (swank-compile-file): Return T for the FAILURE-P
+	return value in case of a FATA-COMPILER-ERROR.
+
+	Reported by Philipp M. Sch?fer
+
+2009-04-03  Tobias C. Rittweiler  <tcr at freebits.de>
+
 	* slime.el (slime-inspector-mode-map): Remove binding for
 	M-RET. (It'll be added by the slime-repl contrib.)
 	(slime-inspector-copy-down): Removed.
--- /project/slime/cvsroot/slime/swank-sbcl.lisp	2009/03/07 19:08:03	1.237
+++ /project/slime/cvsroot/slime/swank-sbcl.lisp	2009/04/03 21:13:00	1.238
@@ -485,10 +485,14 @@
 
 (defimplementation call-with-compilation-hooks (function)
   (declare (type function function))
-  (handler-bind ((sb-c:fatal-compiler-error #'handle-file-compiler-termination)
-                 (sb-c:compiler-error  #'handle-notification-condition)
-                 (sb-ext:compiler-note #'handle-notification-condition)
-                 (warning              #'handle-notification-condition))
+  (handler-bind
+      ;; N.B. Even though these handlers are called HANDLE-FOO they
+      ;; actually decline, i.e. the signalling of the original
+      ;; condition continues upward.
+      ((sb-c:fatal-compiler-error #'handle-file-compiler-termination)
+       (sb-c:compiler-error  #'handle-notification-condition)
+       (sb-ext:compiler-note #'handle-notification-condition)
+       (warning              #'handle-notification-condition))
     (funcall function)))
 
 (defun handle-file-compiler-termination (condition)
@@ -512,7 +516,8 @@
                       (source-cache-get input-file 
                                         (file-write-date input-file))
                       (not (load output-file))))))
-    (sb-c:fatal-compiler-error () nil)))
+    ;; N.B. This comes through despite of WITH-COMPILATION-HOOKS.
+    (sb-c:fatal-compiler-error () (values nil nil t))))
 
 ;;;; compile-string
 




From trittweiler at common-lisp.net  Fri Apr  3 21:14:11 2009
From: trittweiler at common-lisp.net (CVS User trittweiler)
Date: Fri, 03 Apr 2009 17:14:11 -0400
Subject: [slime-cvs] CVS slime
Message-ID: <E1LpqiJ-00067Z-Ff@common-lisp.net>

Update of /project/slime/cvsroot/slime
In directory cl-net:/tmp/cvs-serv23410

Modified Files:
	ChangeLog 
Log Message:
fix typo.


--- /project/slime/cvsroot/slime/ChangeLog	2009/04/03 21:13:00	1.1725
+++ /project/slime/cvsroot/slime/ChangeLog	2009/04/03 21:14:11	1.1726
@@ -1,7 +1,7 @@
 2009-04-03  Tobias C. Rittweiler  <tcr at freebits.de>
 
 	* swank-sbcl.lisp (swank-compile-file): Return T for the FAILURE-P
-	return value in case of a FATA-COMPILER-ERROR.
+	return value in case of a FATAL-COMPILER-ERROR.
 
 	Reported by Philipp M. Sch?fer
 




From trittweiler at common-lisp.net  Tue Apr 21 13:01:16 2009
From: trittweiler at common-lisp.net (CVS User trittweiler)
Date: Tue, 21 Apr 2009 09:01:16 -0400
Subject: [slime-cvs] CVS slime
Message-ID: <E1LwFbA-0001Hn-Ul@common-lisp.net>

Update of /project/slime/cvsroot/slime
In directory cl-net:/tmp/cvs-serv4943

Modified Files:
	slime.el ChangeLog 
Log Message:
	* slime.el (slime-handle-indentation-update): Revert change from
	2009-03-09; that was a thinko.
	([test] indentation): Some basic test case for correct indentation.


--- /project/slime/cvsroot/slime/slime.el	2009/04/03 20:43:11	1.1152
+++ /project/slime/cvsroot/slime/slime.el	2009/04/21 13:01:16	1.1153
@@ -6737,11 +6737,11 @@
   (dolist (info alist)
     (let ((symbol (intern (car info)))
           (indent (cdr info)))
-      (put symbol 'slime-indent indent)
       ;; Does the symbol have an indentation value that we set?
       (when (equal (get symbol 'common-lisp-indent-function)
                    (get symbol 'slime-indent))
-        (put symbol 'common-lisp-indent-function indent))
+        (put symbol 'common-lisp-indent-function indent)
+        (put symbol 'slime-indent indent))
       (run-hook-with-args 'slime-indentation-update-hooks symbol indent))))
 
 
@@ -7853,6 +7853,44 @@
                          (downcase (buffer-string)))))
     (setq slime-buffer-package ":cl-user"))
 
+(def-slime-test indentation (buffer-content point-markers)
+        "Check indentation update to work correctly."
+    '(("
+\(in-package :swank)
+
+\(defmacro with-lolipop (&body body)
+  `(progn , at body))
+
+\(defmacro lolipop (&body body)
+  `(progn , at body))
+
+\(with-lolipop
+  1
+  2
+  42)
+
+\(lolipop
+  1
+  2
+  23)
+"
+       ("23" "42")))
+  (with-temp-buffer
+    (lisp-mode)
+    (slime-mode 1)
+    (insert buffer-content)
+    (slime-compile-region (point-min) (point-max))
+    (slime-sync-to-top-level 3)
+    (slime-update-indentation)
+    (slime-sync-to-top-level 3)
+    (dolist (marker point-markers)
+      (search-backward marker)
+      (beginning-of-defun)
+      (indent-sexp))
+    (slime-test-expect "Correct buffer content"
+                       buffer-content
+                       (substring-no-properties (buffer-string)))))
+
 (def-slime-test break
     (times exp)
     "Test whether BREAK invokes SLDB."
--- /project/slime/cvsroot/slime/ChangeLog	2009/04/03 21:14:11	1.1726
+++ /project/slime/cvsroot/slime/ChangeLog	2009/04/21 13:01:16	1.1727
@@ -1,3 +1,9 @@
+2009-04-21  Tobias C. Rittweiler  <tcr at freebits.de>
+
+	* slime.el (slime-handle-indentation-update): Revert change from
+	2009-03-09; that was a thinko.
+	([test] indentation): Some basic test case for correct indentation.
+
 2009-04-03  Tobias C. Rittweiler  <tcr at freebits.de>
 
 	* swank-sbcl.lisp (swank-compile-file): Return T for the FAILURE-P




From trittweiler at common-lisp.net  Tue Apr 21 13:03:41 2009
From: trittweiler at common-lisp.net (CVS User trittweiler)
Date: Tue, 21 Apr 2009 09:03:41 -0400
Subject: [slime-cvs] CVS slime/contrib
Message-ID: <E1LwFdV-0001JZ-CE@common-lisp.net>

Update of /project/slime/cvsroot/slime/contrib
In directory cl-net:/tmp/cvs-serv5053/contrib

Modified Files:
	slime-indentation-fu.el ChangeLog 
Log Message:
	* slime-indentantion-fu.el (slime-update-local-indentation): Save
	original global indentation spec in another symbol because we
	cannot reuse 'slime-indent. Make sure that later redefinition of
	global macros (which may affect the indentation spec) is taken
	into consideration.


--- /project/slime/cvsroot/slime/contrib/slime-indentation-fu.el	2009/03/27 20:32:55	1.2
+++ /project/slime/cvsroot/slime/contrib/slime-indentation-fu.el	2009/04/21 13:03:41	1.3
@@ -44,7 +44,8 @@
     (let* ((local-arglist (slime-enclosing-macro-arglist form-operator))
            (indent-spec   (if local-arglist
                               (slime-indentation-spec local-arglist)
-                              (get (intern-soft form-operator) 'slime-indent))))
+                              (get (intern-soft form-operator)
+                                   'slime-global-indent))))
       ;; If no &BODY appeared in the arglist, indent like a casual
       ;; function invocation.
       (unless indent-spec
@@ -53,9 +54,19 @@
        indent-spec path containing-form-start sexp-column normal-indent))))
 
 (defun slime-update-local-indentation (ops arg-indices points)
-  (loop for name in (car (slime-find-bound-macros ops arg-indices points)) do 
-        (put (intern name) 'slime-local-indent t) ; unused at the moment, for debugging.
-        (put (intern name) 'common-lisp-indent-function 'slime-indent-fu)))
+  (loop for name in (car (slime-find-bound-macros ops arg-indices points)) do
+        (let ((s (intern name)))
+          ;; N.B. cases to take into considerations: local macro is
+          ;; named like an already existing global macro; such a
+          ;; global macro is redefined with a different lambda-list;
+          ;; initially there's no global macro, but it's added later.
+          ;;
+          (put s 'slime-local-indent t)          ; unused at the moment, for debugging.
+          (unless (eq (get s 'common-lisp-indent-function) 'slime-indent-fu) 
+            (put s 'slime-global-indent (get s 'common-lisp-indent-function)))
+          (put s 'common-lisp-indent-function 'slime-indent-fu)
+          (put s 'slime-indent 'slime-indent-fu) ; for redefinition to be taken up
+          )))
 
 (defun slime-indentation-fu-init ()
   (add-hook 'slime-autodoc-hook 'slime-update-local-indentation))
--- /project/slime/cvsroot/slime/contrib/ChangeLog	2009/04/03 20:43:48	1.199
+++ /project/slime/cvsroot/slime/contrib/ChangeLog	2009/04/21 13:03:41	1.200
@@ -1,3 +1,11 @@
+2009-04-21  Tobias C. Rittweiler  <tcr at freebits.de>
+
+	* slime-indentantion-fu.el (slime-update-local-indentation): Save
+	original global indentation spec in another symbol because we
+	cannot reuse 'slime-indent. Make sure that later redefinition of
+	global macros (which may affect the indentation spec) is taken
+	into consideration.
+
 2009-04-03  Tobias C. Rittweiler  <tcr at freebits.de>
 
 	* slime-repl.el (slime-inspector-mode-map): Add binding for M-RET.




From trittweiler at common-lisp.net  Sat Apr 25 08:53:16 2009
From: trittweiler at common-lisp.net (CVS User trittweiler)
Date: Sat, 25 Apr 2009 04:53:16 -0400
Subject: [slime-cvs] CVS slime
Message-ID: <E1LxddM-0000jT-EI@common-lisp.net>

Update of /project/slime/cvsroot/slime
In directory cl-net:/tmp/cvs-serv2810

Modified Files:
	slime.el ChangeLog 
Log Message:
	* slime.el (slime-show-description): Put the connection name into
	the buffer name for description buffers. So we can have multiple
	description buffers open, one per connection.

	Useful for comparing the output of DISASSEMBLE across
	implementations.


--- /project/slime/cvsroot/slime/slime.el	2009/04/21 13:01:16	1.1153
+++ /project/slime/cvsroot/slime/slime.el	2009/04/25 08:53:16	1.1154
@@ -4107,9 +4107,12 @@
                                        (slime-current-package))))
 
 (defun slime-show-description (string package)
-  (slime-with-popup-buffer ("*SLIME Description*" package)
-    (princ string)
-    (goto-char (point-min))))
+  ;; So we can have one description buffer open per connection. Useful
+  ;; for comparing the output of DISASSEMBLE across implementations.
+  (let ((bufname (format "*SLIME Description <%s>*" (slime-connection-name))))
+    (slime-with-popup-buffer (bufname package t)
+      (princ string)
+      (goto-char (point-min)))))
 
 (defun slime-last-expression ()
   (buffer-substring-no-properties
--- /project/slime/cvsroot/slime/ChangeLog	2009/04/21 13:01:16	1.1727
+++ /project/slime/cvsroot/slime/ChangeLog	2009/04/25 08:53:16	1.1728
@@ -1,3 +1,12 @@
+2009-04-25  Tobias C. Rittweiler  <tcr at freebits.de>
+
+	* slime.el (slime-show-description): Put the connection name into
+	the buffer name for description buffers. So we can have multiple
+	description buffers open, one per connection.
+
+	Useful for comparing the output of DISASSEMBLE across
+	implementations.
+
 2009-04-21  Tobias C. Rittweiler  <tcr at freebits.de>
 
 	* slime.el (slime-handle-indentation-update): Revert change from




From trittweiler at common-lisp.net  Tue Apr 28 20:41:32 2009
From: trittweiler at common-lisp.net (CVS User trittweiler)
Date: Tue, 28 Apr 2009 16:41:32 -0400
Subject: [slime-cvs] CVS slime
Message-ID: <E1Lyu7Q-00008u-Nf@common-lisp.net>

Update of /project/slime/cvsroot/slime
In directory cl-net:/tmp/cvs-serv546

Modified Files:
	ChangeLog slime.el 
Log Message:
	* slime.el: Fix fontification of suppressed (by reader
	conditionals) forms. That is make it reliably and totally work.

	(slime-region-for-extended-defun-at-point): New. Like
	`slime-region-for-defun-at-point' but takes preceding reader
	conditionals into account.
	(slime-extend-region-for-font-lock): New. Make sure that
	fontification operates on regions spanning a whole toplevel form
	only. So we never operate within the context of a reader
	conditional and we never miss any of those.
	(slime-search-suppressed-forms): Remove ignore-errors; not needed
	anymore now as we extend the region for fontification.
	(slime-mark-defun-for-font-lock): New.
	(slime-activate-font-lock-magic): Push
	`slime-extend-region-for-font-lock' onto
	`font-lock-extend-region-functions'.


--- /project/slime/cvsroot/slime/ChangeLog	2009/04/25 08:53:16	1.1728
+++ /project/slime/cvsroot/slime/ChangeLog	2009/04/28 20:41:32	1.1729
@@ -1,3 +1,22 @@
+2009-04-28  Tobias C. Rittweiler  <tcr at freebits.de>
+
+	* slime.el: Fix fontification of suppressed (by reader
+	conditionals) forms. That is make it reliably and totally work.
+
+	(slime-region-for-extended-defun-at-point): New. Like
+	`slime-region-for-defun-at-point' but takes preceding reader
+	conditionals into account.
+	(slime-extend-region-for-font-lock): New. Make sure that
+	fontification operates on regions spanning a whole toplevel form
+	only. So we never operate within the context of a reader
+	conditional and we never miss any of those.
+	(slime-search-suppressed-forms): Remove ignore-errors; not needed
+	anymore now as we extend the region for fontification.
+	(slime-mark-defun-for-font-lock): New.
+	(slime-activate-font-lock-magic): Push
+	`slime-extend-region-for-font-lock' onto
+	`font-lock-extend-region-functions'.
+
 2009-04-25  Tobias C. Rittweiler  <tcr at freebits.de>
 
 	* slime.el (slime-show-description): Put the connection name into
--- /project/slime/cvsroot/slime/slime.el	2009/04/25 08:53:16	1.1154
+++ /project/slime/cvsroot/slime/slime.el	2009/04/28 20:41:32	1.1155
@@ -6685,26 +6685,98 @@
   "Find reader conditionalized forms where the test is false."
   (when (and slime-highlight-suppressed-forms
              (slime-connected-p)
-	     (re-search-forward "^\\([^;\n]*?[ \t(]\\)?#[-+]" limit t))
-    (ignore-errors
-      (let* ((start (- (point) 2))
-             (char (char-before))
-             (e (read (current-buffer)))
-             (val (slime-eval-feature-conditional e)))
-        (when (<= (point) limit)
-          (if (or (and (eq char ?+) (not val))
-                  (and (eq char ?-) val))
-              (progn 
-                (forward-sexp) (backward-sexp)
-                (slime-forward-sexp)
-                (assert (<= (point) limit))
-                (let ((md (match-data)))
-                  (fill md nil)
-                  (setf (first md) start)
-                  (setf (second md) (point))
-                  (set-match-data md)
-                  t))
-            (slime-search-suppressed-forms limit)))))))
+             (re-search-forward "^\\([^;\n]*?[ \t(]\\)?#[-+]" limit t))
+    (let* ((start (- (point) 2))
+           (char (char-before))
+           (e (read (current-buffer)))
+           (val (slime-eval-feature-conditional e)))
+      (when (<= (point) limit)
+        (if (or (and (eq char ?+) (not val))
+                (and (eq char ?-) val))
+            (progn
+              (forward-sexp) (backward-sexp)
+              (slime-forward-sexp)
+              ;; There was an `ignore-errors' form around all this
+              ;; because the following assertion was triggered
+              ;; regularly (resulting in the "non-deterministic"
+              ;; behaviour mentioned in the comment further below.)
+              ;; With extending the region properly, this assertion
+              ;; would truly mean a bug now.
+              (assert (<= (point) limit))
+              (let ((md (match-data)))
+                (fill md nil)
+                (setf (first md) start)
+                (setf (second md) (point))
+                (set-match-data md)
+                t))
+            (slime-search-suppressed-forms limit))))))
+
+(defun slime-region-for-extended-defun-at-point ()
+  "Like `slime-region-for-defun-at-point' except we take
+preceding reader conditionals into account."
+  (destructuring-bind (start end) (slime-region-for-defun-at-point)
+    (save-excursion
+      (goto-char start)
+      ;; At this point we want to watch out for a possibly preceding
+      ;; reader conditional..
+      (save-match-data 
+        (search-backward-regexp slime-reader-conditionals-regexp
+                                ;; We restrict the search to the
+                                ;; beginning of the /next/ defun.
+                                (save-excursion 
+                                  (beginning-of-defun) (point))
+                                t)
+        ;; We actually need to restrict the search to the end of the
+        ;; next defun, but we can't easily determine that end.
+        ;; (`forward-sexp' after the `beginning-of-defun' won't work for
+        ;; a conditionalized form at the top of a file.)
+        ;;
+        ;; As a result, we may be slipped into another defun here, so we
+        ;; have to check against that:
+        (if (zerop (nth 0 (slime-current-parser-state)))
+            (list (point) end)
+            (list start   end))))))
+
+;;; We'll push this onto `font-lock-extend-region-functions'. In past,
+;;; we didn't do so which made our reader-conditional font-lock magic
+;;; pretty unreliable (it wouldn't highlight all suppressed forms, and
+;;; worked quite non-deterministic in general.)
+;;;
+;;; Cf. _Elisp Manual_, 23.6.10 Multiline Font Lock Constructs.
+(defun slime-extend-region-for-font-lock ()
+  ;; We make sure that `font-lock-beg' and `font-lock-end' always
+  ;; point to the beginning or end of a defun. So we never miss a
+  ;; reader-conditional, or point in mid of one.
+  (let ((changedp nil))
+    (goto-char font-lock-beg)
+    (unless (zerop (nth 0 (slime-current-parser-state)))
+      ;; N.B. take initial reader-conditional into account, otherwise
+      ;; fontification wouldn't know the whole function definition may
+      ;; be suppressed. 
+      (setq font-lock-beg (first (slime-region-for-extended-defun-at-point)))
+      (setq changedp t))
+    (goto-char font-lock-end)
+    (unless (zerop (nth 0 (slime-current-parser-state)))
+      (setq font-lock-end (second (slime-region-for-defun-at-point)))
+      (setq changedp t))
+    changedp))
+
+
+;;; FIXME: This is supposed to be the value for
+;;; `font-lock-mark-block-function' (so M-o M-o will DTRT), but I
+;;; couldn't so far figure out how to customize that variable.
+;;; (N.B. `font-lock-defaults' may (in fact does) contain an explicit
+;;; binding of that variable.)
+(defun slime-mark-defun-for-font-lock ()
+  "Almost `mark-defun' but this function sets point to a possibly
+preceding reader-conditional so slime's reader-conditional aware
+font-lock magic has a chance to run."
+  (destructuring-bind (start end) 
+      (slime-region-for-extended-defun-at-point)
+    (goto-char end)
+    (push-mark)
+    (goto-char start)))
+
 
 (defun slime-activate-font-lock-magic ()
   (if (featurep 'xemacs)
@@ -6716,7 +6788,13 @@
           (set sym (append (symbol-value sym) pattern))))
     (font-lock-add-keywords
      'lisp-mode
-     `((slime-search-suppressed-forms 0 ,''slime-reader-conditional-face t)))))
+     `((slime-search-suppressed-forms 0 ,''slime-reader-conditional-face t)))
+
+    (add-hook 'lisp-mode-hook 
+              #'(lambda () 
+                  (add-hook 'font-lock-extend-region-functions
+                            'slime-extend-region-for-font-lock t t)))
+    ))
 
 (when slime-highlight-suppressed-forms
   (slime-activate-font-lock-magic))
@@ -8766,7 +8844,12 @@
           slime-tree-insert
           slime-symbol-constituent-at
           slime-beginning-of-symbol
-          slime-end-of-symbol)))
+          slime-end-of-symbol
+          ;; Used implicitly during fontification:
+          slime-region-for-defun-at-point
+          slime-region-for-extended-defun-at-point
+          slime-extend-region-for-font-lock
+          )))
 
 (provide 'slime)
 (run-hooks 'slime-load-hook)




From trittweiler at common-lisp.net  Wed Apr 29 17:11:14 2009
From: trittweiler at common-lisp.net (CVS User trittweiler)
Date: Wed, 29 Apr 2009 13:11:14 -0400
Subject: [slime-cvs] CVS slime
Message-ID: <E1LzDJS-0007SX-1l@common-lisp.net>

Update of /project/slime/cvsroot/slime
In directory cl-net:/tmp/cvs-serv28662

Modified Files:
	ChangeLog slime.el 
Log Message:
	* slime.el: Fix infinite loop during fontification introduced
	by yesterday's changeset.

	(slime-region-for-tlf-at-point): New. Like
	`slime-region-for-defun-at-point' but tries harder to get the
	toplevel form right.
	(slime-region-for-extended-tlf-at-point): Previously
	`slime-region-for-extended-defun-at-point'.
	(slime-extend-region-for-font-lock): Use it.
	(slime-mark-defun-for-font-lock): Ditto.


--- /project/slime/cvsroot/slime/ChangeLog	2009/04/28 20:41:32	1.1729
+++ /project/slime/cvsroot/slime/ChangeLog	2009/04/29 17:11:13	1.1730
@@ -1,3 +1,16 @@
+2009-04-29  Tobias C. Rittweiler  <tcr at freebits.de>
+
+	* slime.el: Fix infinite loop during fontification introduced
+	by yesterday's changeset.
+
+	(slime-region-for-tlf-at-point): New. Like
+	`slime-region-for-defun-at-point' but tries harder to get the
+	toplevel form right.
+	(slime-region-for-extended-tlf-at-point): Previously
+	`slime-region-for-extended-defun-at-point'.
+	(slime-extend-region-for-font-lock): Use it.
+	(slime-mark-defun-for-font-lock): Ditto.
+
 2009-04-28  Tobias C. Rittweiler  <tcr at freebits.de>
 
 	* slime.el: Fix fontification of suppressed (by reader
--- /project/slime/cvsroot/slime/slime.el	2009/04/28 20:41:32	1.1155
+++ /project/slime/cvsroot/slime/slime.el	2009/04/29 17:11:13	1.1156
@@ -6711,10 +6711,10 @@
                 t))
             (slime-search-suppressed-forms limit))))))
 
-(defun slime-region-for-extended-defun-at-point ()
-  "Like `slime-region-for-defun-at-point' except we take
+(defun slime-region-for-extended-tlf-at-point ()
+  "Like `slime-region-for-tlf-at-point' except we take
 preceding reader conditionals into account."
-  (destructuring-bind (start end) (slime-region-for-defun-at-point)
+  (destructuring-bind (start end) (slime-region-for-tlf-at-point)
     (save-excursion
       (goto-char start)
       ;; At this point we want to watch out for a possibly preceding
@@ -6753,15 +6753,14 @@
       ;; N.B. take initial reader-conditional into account, otherwise
       ;; fontification wouldn't know the whole function definition may
       ;; be suppressed. 
-      (setq font-lock-beg (first (slime-region-for-extended-defun-at-point)))
+      (setq font-lock-beg (first (slime-region-for-extended-tlf-at-point)))
       (setq changedp t))
     (goto-char font-lock-end)
     (unless (zerop (nth 0 (slime-current-parser-state)))
-      (setq font-lock-end (second (slime-region-for-defun-at-point)))
+      (setq font-lock-end (second (slime-region-for-tlf-at-point)))
       (setq changedp t))
     changedp))
 
-
 ;;; FIXME: This is supposed to be the value for
 ;;; `font-lock-mark-block-function' (so M-o M-o will DTRT), but I
 ;;; couldn't so far figure out how to customize that variable.
@@ -6772,7 +6771,7 @@
 preceding reader-conditional so slime's reader-conditional aware
 font-lock magic has a chance to run."
   (destructuring-bind (start end) 
-      (slime-region-for-extended-defun-at-point)
+      (slime-region-for-extended-tlf-at-point)
     (goto-char end)
     (push-mark)
     (goto-char start)))
@@ -8270,7 +8269,7 @@
          (slime-region-for-defun-at-point)))
 
 (defun slime-region-for-defun-at-point ()
-  "Return the start and end position of the toplevel form at point."
+  "Return the start and end position of defun at point."
   (save-excursion
     (save-match-data
       (end-of-defun)
@@ -8278,6 +8277,27 @@
         (beginning-of-defun)
         (list (point) end)))))
 
+;;; This may coincide with `slime-region-for-defun-at-point' but this
+;;; function really tries to find out the toplevel form not just a
+;;; form that begins at the 0th column. It's not guaranteed to work
+;;; reliably, though, as it relies on Emacs' parser state which is
+;;; context-sensitive. Works quite good when the buffer is processed
+;;; from top to bottom (e.g. during fontification.)
+(defun slime-region-for-tlf-at-point ()
+  "Return the start and end position of the toplevel form at point."
+  (save-excursion
+    (save-match-data
+      ;; Position us at the beginning of the current defun.
+      (end-of-defun) 
+      (beginning-of-defun)
+      (while (not (zerop (nth 0 (slime-current-parser-state))))
+        ;; We go upwards, not downwards, to hopefully give the parser
+        ;; state enough context to be accurate.
+        (beginning-of-defun))
+      (let ((start (point)))
+        (end-of-defun)
+        (list start (point))))))
+
 (defun slime-exit-vertical-bars ()
   "Move out from within vertical bars (|foo|) to the leading bar."
   (let* ((parser-state (slime-current-parser-state))
@@ -8407,13 +8427,13 @@
 
 (if (and (featurep 'emacs) (>= emacs-major-version 22))
     ;;  N.B. The 2nd, and 6th return value cannot be relied upon.
-    (defun slime-current-parser-state ()
+    (defsubst slime-current-parser-state ()
       ;; `syntax-ppss' does not save match data as it invokes
       ;; `beginning-of-defun' implicitly which does not save match
       ;; data. This issue has been reported to the Emacs maintainer on
       ;; Feb27.
       (save-match-data (syntax-ppss)))
-    (defun slime-current-parser-state ()
+    (defsubst slime-current-parser-state ()
       (let ((original-pos (point)))
         (save-excursion
           (beginning-of-defun)
@@ -8846,9 +8866,14 @@
           slime-beginning-of-symbol
           slime-end-of-symbol
           ;; Used implicitly during fontification:
-          slime-region-for-defun-at-point
-          slime-region-for-extended-defun-at-point
+          slime-current-parser-state
+          slime-forward-sexp
+          slime-forward-cruft
+          slime-forward-any-comment
+          slime-region-for-tlf-at-point
+          slime-region-for-extended-tlf-at-point
           slime-extend-region-for-font-lock
+          slime-search-suppressed-forms
           )))
 
 (provide 'slime)




From trittweiler at common-lisp.net  Wed Apr 29 22:05:16 2009
From: trittweiler at common-lisp.net (CVS User trittweiler)
Date: Wed, 29 Apr 2009 18:05:16 -0400
Subject: [slime-cvs] CVS slime
Message-ID: <E1LzHu0-0001lz-Fd@common-lisp.net>

Update of /project/slime/cvsroot/slime
In directory cl-net:/tmp/cvs-serv6815

Modified Files:
	ChangeLog slime.el 
Log Message:
	* slime.el (slime-extend-region-for-font-lock): (nth 0
	<parser-state>) may return negative numbers.


--- /project/slime/cvsroot/slime/ChangeLog	2009/04/29 17:11:13	1.1730
+++ /project/slime/cvsroot/slime/ChangeLog	2009/04/29 22:05:16	1.1731
@@ -1,5 +1,10 @@
 2009-04-29  Tobias C. Rittweiler  <tcr at freebits.de>
 
+	* slime.el (slime-extend-region-for-font-lock): (nth 0
+	<parser-state>) may return negative numbers.
+
+2009-04-29  Tobias C. Rittweiler  <tcr at freebits.de>
+
 	* slime.el: Fix infinite loop during fontification introduced
 	by yesterday's changeset.
 
--- /project/slime/cvsroot/slime/slime.el	2009/04/29 17:11:13	1.1156
+++ /project/slime/cvsroot/slime/slime.el	2009/04/29 22:05:16	1.1157
@@ -6749,14 +6749,14 @@
   ;; reader-conditional, or point in mid of one.
   (let ((changedp nil))
     (goto-char font-lock-beg)
-    (unless (zerop (nth 0 (slime-current-parser-state)))
+    (when (plusp (nth 0 (slime-current-parser-state)))
       ;; N.B. take initial reader-conditional into account, otherwise
       ;; fontification wouldn't know the whole function definition may
       ;; be suppressed. 
       (setq font-lock-beg (first (slime-region-for-extended-tlf-at-point)))
       (setq changedp t))
     (goto-char font-lock-end)
-    (unless (zerop (nth 0 (slime-current-parser-state)))
+    (when (plusp (nth 0 (slime-current-parser-state)))
       (setq font-lock-end (second (slime-region-for-tlf-at-point)))
       (setq changedp t))
     changedp))




From trittweiler at common-lisp.net  Wed Apr 29 22:20:25 2009
From: trittweiler at common-lisp.net (CVS User trittweiler)
Date: Wed, 29 Apr 2009 18:20:25 -0400
Subject: [slime-cvs] CVS slime
Message-ID: <E1LzI8f-0002Ox-A2@common-lisp.net>

Update of /project/slime/cvsroot/slime
In directory cl-net:/tmp/cvs-serv8388

Modified Files:
	ChangeLog swank-backend.lisp swank-openmcl.lisp 
Log Message:
	* swank-backend.lisp ([default] declaration-arglist): Add
	arglist of DECLARATION declaration.

	* swank-openmcl.lisp ([eql 'optimize] declaration-arglist):
	Implement it for CCL.
	(describe-symbol-for-emacs): Add :CLASS and :TYPE.
	(describe-definition): Add :TYPE.

	* swank-sbcl.lisp (describe-symbol-for-emacs): Add :CLASS.

	Adapted from patch by Stas Boukarev.


--- /project/slime/cvsroot/slime/ChangeLog	2009/04/29 22:05:16	1.1731
+++ /project/slime/cvsroot/slime/ChangeLog	2009/04/29 22:20:25	1.1732
@@ -1,3 +1,17 @@
+2009-04-30  Tobias C. Rittweiler  <tcr at freebits.de>
+
+	* swank-backend.lisp ([default] declaration-arglist): Add
+	arglist of DECLARATION declaration.
+
+	* swank-openmcl.lisp ([eql 'optimize] declaration-arglist):
+	Implement it for CCL.
+	(describe-symbol-for-emacs): Add :CLASS and :TYPE.
+	(describe-definition): Add :TYPE.
+
+	* swank-sbcl.lisp (describe-symbol-for-emacs): Add :CLASS.
+
+	Adapted from patch by Stas Boukarev.
+
 2009-04-29  Tobias C. Rittweiler  <tcr at freebits.de>
 
 	* slime.el (slime-extend-region-for-font-lock): (nth 0
--- /project/slime/cvsroot/slime/swank-backend.lisp	2009/02/26 19:57:35	1.174
+++ /project/slime/cvsroot/slime/swank-backend.lisp	2009/04/29 22:20:25	1.175
@@ -521,7 +521,8 @@
       (ignorable      '(&rest vars))
       (special        '(&rest vars))
       (inline         '(&rest function-names))
-      (notinline      '(&rest function-name))
+      (notinline      '(&rest function-names))
+      (declaration    '(&rest names))
       (optimize       '(&any compilation-speed debug safety space speed))  
       (type           '(type-specifier &rest args))
       (ftype          '(type-specifier &rest function-names))
--- /project/slime/cvsroot/slime/swank-openmcl.lisp	2009/03/27 12:58:45	1.160
+++ /project/slime/cvsroot/slime/swank-openmcl.lisp	2009/04/29 22:20:25	1.161
@@ -219,6 +219,12 @@
 (defimplementation function-name (function)
   (ccl:function-name function))
 
+(defmethod declaration-arglist ((decl-identifier (eql 'optimize)))
+  (let ((flags (ccl:declaration-information decl-identifier)))
+    (if flags
+        `(&any ,flags)
+        (call-next-method))))
+
 ;;; Compilation
 
 (defvar *buffer-offset* nil)
@@ -871,6 +877,12 @@
                                         `(setf ,symbol))))
                (when (fboundp setf-function-name)
                  (doc 'function setf-function-name))))
+      (maybe-push
+       :class (when (find-class symbol nil)
+                (doc 'class)))
+      (maybe-push
+       :type (when (ccl:type-specifier-p symbol)
+               (doc 'type)))
       result)))
 
 (defimplementation describe-definition (symbol namespace)
@@ -882,7 +894,9 @@
     (:setf
      (describe (ccl::setf-function-spec-name `(setf ,symbol))))
     (:class
-     (describe (find-class symbol)))))
+     (describe (find-class symbol)))
+    (:type
+     (describe symbol))))
 
 (defimplementation toggle-trace (spec)
   "We currently ignore just about everything."




From trittweiler at common-lisp.net  Wed Apr 29 22:21:31 2009
From: trittweiler at common-lisp.net (CVS User trittweiler)
Date: Wed, 29 Apr 2009 18:21:31 -0400
Subject: [slime-cvs] CVS slime
Message-ID: <E1LzI9j-0002VX-M4@common-lisp.net>

Update of /project/slime/cvsroot/slime
In directory cl-net:/tmp/cvs-serv9639

Modified Files:
	swank-sbcl.lisp 
Log Message:
	* swank-backend.lisp ([default] declaration-arglist): Add
	arglist of DECLARATION declaration.

	* swank-openmcl.lisp ([eql 'optimize] declaration-arglist):
	Implement it for CCL.
	(describe-symbol-for-emacs): Add :CLASS and :TYPE.
	(describe-definition): Add :TYPE.

	* swank-sbcl.lisp (describe-symbol-for-emacs): Add :CLASS.

	Adapted from patch by Stas Boukarev.


--- /project/slime/cvsroot/slime/swank-sbcl.lisp	2009/04/03 21:13:00	1.238
+++ /project/slime/cvsroot/slime/swank-sbcl.lisp	2009/04/29 22:21:31	1.239
@@ -761,6 +761,9 @@
 		     (sb-int:info :setf :expander symbol))
 		 (doc 'setf)))
       (maybe-push
+       :class (when (find-class symbol nil)
+                (doc 'class)))
+      (maybe-push
        :type (if (sb-int:info :type :kind symbol)
 		 (doc 'type)))
       result)))




From trittweiler at common-lisp.net  Wed Apr 29 22:29:18 2009
From: trittweiler at common-lisp.net (CVS User trittweiler)
Date: Wed, 29 Apr 2009 18:29:18 -0400
Subject: [slime-cvs] CVS slime
Message-ID: <E1LzIHG-0002Xi-Gf@common-lisp.net>

Update of /project/slime/cvsroot/slime
In directory cl-net:/tmp/cvs-serv9773

Modified Files:
	ChangeLog swank-openmcl.lisp swank-sbcl.lisp 
Log Message:
Fix thinko. DOCUMENTATION does not support :CLASS.


--- /project/slime/cvsroot/slime/ChangeLog	2009/04/29 22:20:25	1.1732
+++ /project/slime/cvsroot/slime/ChangeLog	2009/04/29 22:29:18	1.1733
@@ -5,11 +5,9 @@
 
 	* swank-openmcl.lisp ([eql 'optimize] declaration-arglist):
 	Implement it for CCL.
-	(describe-symbol-for-emacs): Add :CLASS and :TYPE.
+	(describe-symbol-for-emacs): Add :TYPE.
 	(describe-definition): Add :TYPE.
 
-	* swank-sbcl.lisp (describe-symbol-for-emacs): Add :CLASS.
-
 	Adapted from patch by Stas Boukarev.
 
 2009-04-29  Tobias C. Rittweiler  <tcr at freebits.de>
--- /project/slime/cvsroot/slime/swank-openmcl.lisp	2009/04/29 22:20:25	1.161
+++ /project/slime/cvsroot/slime/swank-openmcl.lisp	2009/04/29 22:29:18	1.162
@@ -878,9 +878,6 @@
                (when (fboundp setf-function-name)
                  (doc 'function setf-function-name))))
       (maybe-push
-       :class (when (find-class symbol nil)
-                (doc 'class)))
-      (maybe-push
        :type (when (ccl:type-specifier-p symbol)
                (doc 'type)))
       result)))
@@ -896,7 +893,7 @@
     (:class
      (describe (find-class symbol)))
     (:type
-     (describe symbol))))
+     (describe (or (find-class symbol nil) symbol)))))
 
 (defimplementation toggle-trace (spec)
   "We currently ignore just about everything."
--- /project/slime/cvsroot/slime/swank-sbcl.lisp	2009/04/29 22:21:31	1.239
+++ /project/slime/cvsroot/slime/swank-sbcl.lisp	2009/04/29 22:29:18	1.240
@@ -761,9 +761,6 @@
 		     (sb-int:info :setf :expander symbol))
 		 (doc 'setf)))
       (maybe-push
-       :class (when (find-class symbol nil)
-                (doc 'class)))
-      (maybe-push
        :type (if (sb-int:info :type :kind symbol)
 		 (doc 'type)))
       result)))




From trittweiler at common-lisp.net  Wed Apr 29 23:26:36 2009
From: trittweiler at common-lisp.net (CVS User trittweiler)
Date: Wed, 29 Apr 2009 19:26:36 -0400
Subject: [slime-cvs] CVS slime/contrib
Message-ID: <E1LzJAi-0004w9-Ke@common-lisp.net>

Update of /project/slime/cvsroot/slime/contrib
In directory cl-net:/tmp/cvs-serv18977/contrib

Modified Files:
	ChangeLog slime-parse.el 
Log Message:
	* slime-parse.el (slime-parse-extended-operator/proclaim): New.
	(slime-extended-oprator-name-parser-alist): Adapt tbe entry for
	PROCLAIM.


--- /project/slime/cvsroot/slime/contrib/ChangeLog	2009/04/21 13:03:41	1.200
+++ /project/slime/cvsroot/slime/contrib/ChangeLog	2009/04/29 23:26:36	1.201
@@ -1,3 +1,9 @@
+2009-04-30  Tobias C. Rittweiler  <tcr at freebits.de>
+
+	* slime-parse.el (slime-parse-extended-operator/proclaim): New.
+	(slime-extended-oprator-name-parser-alist): Adapt tbe entry for
+	PROCLAIM.
+
 2009-04-21  Tobias C. Rittweiler  <tcr at freebits.de>
 
 	* slime-indentantion-fu.el (slime-update-local-indentation): Save
--- /project/slime/cvsroot/slime/contrib/slime-parse.el	2009/02/27 21:35:35	1.19
+++ /project/slime/cvsroot/slime/contrib/slime-parse.el	2009/04/29 23:26:36	1.20
@@ -107,7 +107,7 @@
     ("APPLY"          . (slime-make-extended-operator-parser/look-ahead 1))
     ("DECLARE"        . slime-parse-extended-operator/declare)
     ("DECLAIM"        . slime-parse-extended-operator/declare)
-    ("PROCLAIM"       . slime-parse-extended-operator/declare)))
+    ("PROCLAIM"       . slime-parse-extended-operator/proclaim)))
 
 (defun slime-make-extended-operator-parser/look-ahead (steps)
   "Returns a parser that parses the current operator at point
@@ -128,14 +128,21 @@
           (values current-forms current-indices current-points)
           ))))
 
+;;; FIXME: We display "(proclaim (optimize ...))" instead of the
+;;; correct "(proclaim '(optimize ...))".
+(defun slime-parse-extended-operator/proclaim (&rest args)
+  (when (looking-at "['`]")
+    (forward-char)
+    (apply #'slime-parse-extended-operator/declare args)))
+
 (defun slime-parse-extended-operator/declare
     (name user-point current-forms current-indices current-points)
-  (when (string= (thing-at-point 'char) "(")
+  (when (looking-at "(")
     (let ((orig-point (point)))
       (goto-char user-point)
       (slime-end-of-symbol)
-      ;; Head of CURRENT-FORMS is "declare" at this point, but we're
-      ;; interested in what comes next.
+      ;; Head of CURRENT-FORMS is "declare" (or similiar) at this
+      ;; point, but we're interested in what comes next.
       (let* ((decl-ops     (rest current-forms))
              (decl-indices (rest current-indices))
              (decl-points  (rest current-points))




From trittweiler at common-lisp.net  Thu Apr 30 12:38:02 2009
From: trittweiler at common-lisp.net (CVS User trittweiler)
Date: Thu, 30 Apr 2009 08:38:02 -0400
Subject: [slime-cvs] CVS slime/contrib
Message-ID: <E1LzVWc-0003Ho-DJ@common-lisp.net>

Update of /project/slime/cvsroot/slime/contrib
In directory cl-net:/tmp/cvs-serv12633/contrib

Modified Files:
	ChangeLog slime-parse.el 
Log Message:
	* slime.el (slime-parse-extended-operator/check-type): New.
	(slime-parse-extended-operator/the): New.
	(slime-extended-operator-name-parser-alist): Add entries for
	CHECK-TYPE, TYPEP, and THE.
	([tes??] enclosing-form-specs.1): Add tests for the new entries.


--- /project/slime/cvsroot/slime/contrib/ChangeLog	2009/04/29 23:26:36	1.201
+++ /project/slime/cvsroot/slime/contrib/ChangeLog	2009/04/30 12:38:02	1.202
@@ -1,9 +1,21 @@
 2009-04-30  Tobias C. Rittweiler  <tcr at freebits.de>
 
+	* slime.el (slime-parse-extended-operator/check-type): New.
+	(slime-parse-extended-operator/the): New.
+	(slime-extended-operator-name-parser-alist): Add entries for
+	CHECK-TYPE, TYPEP, and THE.
+	([tes??] enclosing-form-specs.1): Add tests for the new entries.
+
+	Adapted from patch by Stas Boukarev.
+
+2009-04-30  Tobias C. Rittweiler  <tcr at freebits.de>
+
 	* slime-parse.el (slime-parse-extended-operator/proclaim): New.
-	(slime-extended-oprator-name-parser-alist): Adapt tbe entry for
+	(slime-extended-oprator-name-parser-alist): Adapt the entry for
 	PROCLAIM.
 
+	Adapted from patch by Stas Boukarev.
+
 2009-04-21  Tobias C. Rittweiler  <tcr at freebits.de>
 
 	* slime-indentantion-fu.el (slime-update-local-indentation): Save
@@ -165,7 +177,7 @@
 	anymore.
 	([test] enclosing-context.1): Adapted due to the changes.
 
-2009-02-25  Lu?s Oliveira  <loliveira at common-lisp.net>
+2009-02-25  Lu??s Oliveira  <loliveira at common-lisp.net>
 
 	* slime-compiler-notes-tree.el: Fix typo in the `provide' form.
 
@@ -510,7 +522,7 @@
 
 	* slime-fancy.el: Add slime-fontifying-fu.
 
-2008-08-20  Lu?s Oliveira  <loliveira at common-lisp.net>
+2008-08-20  Lu??s Oliveira  <loliveira at common-lisp.net>
 
 	* contrib/slime-indentation.el: fix indentation of IF forms.
 
@@ -597,7 +609,7 @@
 	(slime-qualify-cl-symbol-name): Moved back to `slime.el' as
 	they're still used there.
 
-2008-04-17  G?bor Melis <mega at retes.hu>
+2008-04-17  G??bor Melis <mega at retes.hu>
 
 	* swank-fancy-inspector.lisp (inspect-slot-for-emacs):
 	slime-read-object has been gone for a long time, replaced with
--- /project/slime/cvsroot/slime/contrib/slime-parse.el	2009/04/29 23:26:36	1.20
+++ /project/slime/cvsroot/slime/contrib/slime-parse.el	2009/04/30 12:38:02	1.21
@@ -72,8 +72,7 @@
 parsing, and are then returned back as multiple values."
   ;; OPS, INDICES and POINTS are like the finally returned values of
   ;; SLIME-ENCLOSING-FORM-SPECS except that they're in reversed order,
-  ;; i.e. the leftmost (that is the latest) operator comes
-  ;; first.
+  ;; i.e. the leftmost operator comes first.
   (save-excursion
     (ignore-errors
       (let* ((current-op (first (first forms)))
@@ -107,7 +106,11 @@
     ("APPLY"          . (slime-make-extended-operator-parser/look-ahead 1))
     ("DECLARE"        . slime-parse-extended-operator/declare)
     ("DECLAIM"        . slime-parse-extended-operator/declare)
-    ("PROCLAIM"       . slime-parse-extended-operator/proclaim)))
+    ("PROCLAIM"       . slime-parse-extended-operator/proclaim)
+    ("CHECK-TYPE"     . slime-parse-extended-operator/check-type)
+    ("TYPEP"          . slime-parse-extended-operator/check-type)
+    ("THE"            . slime-parse-extended-operator/the)))
+
 
 (defun slime-make-extended-operator-parser/look-ahead (steps)
   "Returns a parser that parses the current operator at point
@@ -138,36 +141,66 @@
 (defun slime-parse-extended-operator/declare
     (name user-point current-forms current-indices current-points)
   (when (looking-at "(")
-    (let ((orig-point (point)))
-      (goto-char user-point)
-      (slime-end-of-symbol)
-      ;; Head of CURRENT-FORMS is "declare" (or similiar) at this
-      ;; point, but we're interested in what comes next.
-      (let* ((decl-ops     (rest current-forms))
-             (decl-indices (rest current-indices))
-             (decl-points  (rest current-points))
-             (decl-pos     (1- (first decl-points)))
-             (nesting      (slime-nesting-until-point decl-pos))
-             (declspec-str (concat (slime-incomplete-sexp-at-point nesting)
-                                   (make-string nesting ?\)))))
-        (save-match-data ; `(declare ((foo ...))' or `(declare (type (foo ...)))' ?
-          (if (or (eql 0 (string-match "\\s-*(\\((\\(\\sw\\|\\s_\\|\\s-\\)*)\\))$"
-                                       declspec-str))
-                  (eql 0 (string-match "\\s-*(type\\s-*\\((\\(\\sw\\|\\s_\\|\\s-\\)*)\\))$"
-                                       declspec-str)))
-              (let* ((typespec-str (match-string 1 declspec-str))
-                     (typespec (slime-make-form-spec-from-string typespec-str)))
-                (setq current-forms   (list `(:type-specifier ,typespec)))
-                (setq current-indices (list (second decl-indices)))
-                (setq current-points  (list (second decl-points))))
-              (let ((declspec (slime-make-form-spec-from-string declspec-str)))
-                (setq current-forms   (list `(,name) `(:declaration ,declspec)))
-                (setq current-indices (list (first current-indices)
-					    (first decl-indices)))
-                (setq current-points  (list (first current-points)
-					    (first decl-points)))))))))
+    (goto-char user-point)
+    (slime-end-of-symbol)
+    ;; Head of CURRENT-FORMS is "declare" (or similiar) at this
+    ;; point, but we're interested in what comes next.
+    (let* ((decl-indices (rest current-indices))
+           (decl-points  (rest current-points))
+           (decl-pos     (1- (first decl-points)))
+           (nesting      (slime-nesting-until-point decl-pos))
+           (declspec-str (concat (slime-incomplete-sexp-at-point nesting)
+                                 (make-string nesting ?\)))))
+      (save-match-data ; `(declare ((foo ...))' or `(declare (type (foo ...)))' ?
+        (if (or (eql 0 (string-match "\\s-*(\\((\\(\\sw\\|\\s_\\|\\s-\\)*)\\))$"
+                                     declspec-str))
+                (eql 0 (string-match "\\s-*(type\\s-*\\((\\(\\sw\\|\\s_\\|\\s-\\)*)\\))$"
+                                     declspec-str)))
+            (let* ((typespec-str (match-string 1 declspec-str))
+                   (typespec (slime-make-form-spec-from-string typespec-str)))
+              (setq current-forms   (list `(:type-specifier ,typespec)))
+              (setq current-indices (list (second decl-indices)))
+              (setq current-points  (list (second decl-points))))
+            (let ((declspec (slime-make-form-spec-from-string declspec-str)))
+              (setq current-forms   (list `(,name) `(:declaration ,declspec)))
+              (setq current-indices (list (first current-indices)
+                                          (first decl-indices)))
+              (setq current-points  (list (first current-points)
+                                          (first decl-points))))))))
   (values current-forms current-indices current-points))
 
+(defun slime-parse-extended-operator/check-type
+    (name user-point current-forms current-indices current-points)
+ (tcr:debugmsg "%S %S %S %S %S" name user-point current-forms current-indices current-points)
+  (let ((arg-idx        (first current-indices))
+        (typespec       (second current-forms))
+        (typespec-start (second current-points)))
+    (when (and (eql 2 arg-index)
+               typespec                   ; `(check-type ... (foo |' ?
+               (if (equalp name "typep")  ; `(typep ... '(foo |' ?
+                   (progn (goto-char (- typespec-start 2))
+                          (looking-at "['`]"))
+                   t))
+        ;; compound types VALUES and FUNCTION are not allowed in TYPEP
+        ;; (and consequently CHECK-TYPE.)
+        (unless (member (first typespec) '("values" "function"))
+          (setq current-forms   `((:type-specifier ,typespec)))
+          (setq current-indices (rest current-indices))
+          (setq current-points  (rest current-points))))
+    (values current-forms current-indices current-points)))
+
+(defun slime-parse-extended-operator/the
+    (name user-point current-forms current-indices current-points)
+  (let ((arg-idx  (first current-indices))
+        (typespec (second current-forms)))
+    (if (and (eql 1 arg-idx) typespec)  ; `(the (foo |' ?
+        (values `((:type-specifier ,typespec))
+                (rest current-indices)
+                (rest current-points))
+        (values current-forms current-indices current-points))))
+
+
+
 (defun slime-nesting-until-point (target-point)
   "Returns the nesting level between current point and TARGET-POINT.
 If TARGET-POINT could not be reached, 0 is returned. (As a result
@@ -353,21 +386,25 @@
 (def-slime-test enclosing-form-specs.1
     (buffer-sexpr wished-form-specs)
     "Check that we correctly determine enclosing forms."
-    '(("(defun *HERE*"                (("defun")))
-      ("(defun foo *HERE*"            (("defun")))
-      ("(defun foo (x y) *HERE*"      (("defun")))
-      ("(defmethod *HERE*"            (("defmethod")))
-      ("(defmethod foo *HERE*"        (("defmethod" "foo")))
-      ("(cerror foo *HERE*"           (("cerror" "foo")))
-      ("(cerror foo bar *HERE*"       (("cerror" "foo" "bar")))
-      ("(make-instance foo *HERE*"    (("make-instance" "foo")))
-      ("(apply 'foo *HERE*"           (("apply" "'foo")))
-      ("(apply #'foo *HERE*"          (("apply" "#'foo")))
-      ("(declare *HERE*"              (("declare")))
-      ("(declare (optimize *HERE*"    ((:declaration ("optimize")) ("declare")))
-      ("(declare (string *HERE*"      ((:declaration ("string")) ("declare")))
-      ("(declare ((vector *HERE*"     ((:type-specifier ("vector"))))
-      ("(declare ((vector bit *HERE*" ((:type-specifier ("vector" "bit")))))
+    '(("(defun *HERE*"                  (("defun")))
+      ("(defun foo *HERE*"              (("defun")))
+      ("(defun foo (x y) *HERE*"        (("defun")))
+      ("(defmethod *HERE*"              (("defmethod")))
+      ("(defmethod foo *HERE*"          (("defmethod" "foo")))
+      ("(cerror foo *HERE*"             (("cerror" "foo")))
+      ("(cerror foo bar *HERE*"         (("cerror" "foo" "bar")))
+      ("(make-instance foo *HERE*"      (("make-instance" "foo")))
+      ("(apply 'foo *HERE*"             (("apply" "'foo")))
+      ("(apply #'foo *HERE*"            (("apply" "#'foo")))
+      ("(declare *HERE*"                (("declare")))
+      ("(declare (optimize *HERE*"      ((:declaration ("optimize")) ("declare")))
+      ("(declare (string *HERE*"        ((:declaration ("string")) ("declare")))
+      ("(declare ((vector *HERE*"       ((:type-specifier ("vector"))))
+      ("(declare ((vector bit *HERE*"   ((:type-specifier ("vector" "bit"))))
+      ("(proclaim '(optimize *HERE*"    ((:declaration ("optimize")) ("proclaim")))
+      ("(the (string *HERE*"            ((:type-specifier ("string"))))
+      ("(check-type foo (string *HERE*" ((:type-specifier ("string"))))
+      ("(typep foo '(string *HERE*"     ((:type-specifier ("string")))))
   (slime-check-top-level)
   (with-temp-buffer
     (lisp-mode)




From trittweiler at common-lisp.net  Thu Apr 30 12:50:25 2009
From: trittweiler at common-lisp.net (CVS User trittweiler)
Date: Thu, 30 Apr 2009 08:50:25 -0400
Subject: [slime-cvs] CVS slime
Message-ID: <E1LzVib-0004AJ-GX@common-lisp.net>

Update of /project/slime/cvsroot/slime
In directory cl-net:/tmp/cvs-serv16012

Modified Files:
	ChangeLog swank-abcl.lisp 
Log Message:
	* swank-abcl.lisp: Really commit Vodonosov's patch from
	2009-03-09.


--- /project/slime/cvsroot/slime/ChangeLog	2009/04/29 22:29:18	1.1733
+++ /project/slime/cvsroot/slime/ChangeLog	2009/04/30 12:50:25	1.1734
@@ -1,5 +1,10 @@
 2009-04-30  Tobias C. Rittweiler  <tcr at freebits.de>
 
+	* swank-abcl.lisp: Really commit Vodonosov's patch from
+	2009-03-09.
+
+2009-04-30  Tobias C. Rittweiler  <tcr at freebits.de>
+
 	* swank-backend.lisp ([default] declaration-arglist): Add
 	arglist of DECLARATION declaration.
 
--- /project/slime/cvsroot/slime/swank-abcl.lisp	2009/01/10 12:25:16	1.63
+++ /project/slime/cvsroot/slime/swank-abcl.lisp	2009/04/30 12:50:25	1.64
@@ -132,8 +132,26 @@
 
 (defimplementation accept-connection (socket 
                                       &key external-format buffering timeout)
-  (declare (ignore buffering timeout external-format))
-  (ext:get-socket-stream (ext:socket-accept socket)))
+  (declare (ignore buffering timeout))
+  (ext:get-socket-stream (ext:socket-accept socket)
+                         :external-format external-format))
+
+;;;; External formats
+
+(defvar *external-format-to-coding-system*
+  '((:iso-8859-1 "latin-1" "iso-latin-1" "iso-8859-1")
+    ((:iso-8859-1 :eol-style :lf) "latin-1-unix" "iso-latin-1-unix" "iso-8859-1-unix")
+    (:utf-8 "utf-8")
+    ((:utf-8 :eol-style :lf) "utf-8-unix")
+    (:euc-jp "euc-jp")
+    ((:euc-jp :eol-style :lf) "euc-jp-unix")
+    (:us-ascii "us-ascii")
+    ((:us-ascii :eol-style :lf) "us-ascii-unix")))
+
+(defimplementation find-external-format (coding-system)
+  (car (rassoc-if (lambda (x)
+                    (member coding-system x :test #'equal))
+                  *external-format-to-coding-system*)))
 
 ;;;; Unix signals