From nsiivola at common-lisp.net  Sat Jun  4 18:20:16 2011
From: nsiivola at common-lisp.net (CVS User nsiivola)
Date: Sat, 04 Jun 2011 11:20:16 -0700
Subject: [slime-cvs] CVS slime/contrib
Message-ID: <E1QSvSK-0004Yw-Dd@common-lisp.net>

Update of /project/slime/cvsroot/slime/contrib
In directory common-lisp.net:/tmp/cvs-serv17536/contrib

Modified Files:
	ChangeLog slime-cl-indent.el 
Log Message:
slime-indentation: better named-lambda and destructuring-bind indentation

  Make both apply the newfangled lambda-list indentation mechanism.


--- /project/slime/cvsroot/slime/contrib/ChangeLog	2011/05/31 10:30:02	1.463
+++ /project/slime/cvsroot/slime/contrib/ChangeLog	2011/06/04 18:20:15	1.464
@@ -1,3 +1,9 @@
+2011-06-04  Nikodemus Siivola  <nikodemus at random-state.net>
+
+	* slime-cl-indent.el (toplevel):
+	(run-lisp-indent-tests): Better named-lambda and
+	destructuring-bind indenation.
+
 2011-05-31  Stas Boukarev  <stassats at gmail.com>
 
 	* slime-package-fu.el (slime-export-symbol-representation-auto):
--- /project/slime/cvsroot/slime/contrib/slime-cl-indent.el	2011/05/19 18:25:40	1.25
+++ /project/slime/cvsroot/slime/contrib/slime-cl-indent.el	2011/06/04 18:20:15	1.26
@@ -1046,8 +1046,7 @@
            (defpackage  (4 2))
            (defstruct   ((&whole 4 &rest (&whole 2 &rest 1))
                          &rest (&whole 2 &rest 1)))
-           (destructuring-bind
-                        ((&whole 6 &rest 1) 4 &body))
+           (destructuring-bind (&lambda 4 &body))
            (do          lisp-indent-do)
            (do* . do)
            (dolist      ((&whole 4 2 1) &body))
@@ -1077,6 +1076,7 @@
            (multiple-value-prog1 1)
            (multiple-value-setq (4 2))
            (multiple-value-setf . multiple-value-setq)
+           (named-lambda (4 &lambda &rest lisp-indent-function-lambda-hack))
            (pprint-logical-block (4 2))
            (print-unreadable-object ((&whole 4 1 &rest 1) &body))
            ;; Combines the worst features of BLOCK, LET and TAGBODY
@@ -1373,7 +1373,24 @@
                       &rest r
                       &key k1 k2
                       k3 k4)
-        'hello)"))))
+        'hello)")
+       (((lisp-lambda-list-keyword-parameter-alignment t)
+         (lisp-lambda-list-keyword-alignment t))
+        "
+     (destructuring-bind (foo &optional x
+                                        y 
+                              &key bar
+                                   quux)
+         foo
+       body)")
+       (((lisp-lambda-list-keyword-parameter-alignment t)
+         (lisp-lambda-list-keyword-alignment t))
+        "
+     (named-lambda foo
+         (x &optional y
+                      z
+            &rest more)
+       body)"))))
 
 
 




From jgarcia at common-lisp.net  Sun Jun  5 13:29:20 2011
From: jgarcia at common-lisp.net (CVS User jgarcia)
Date: Sun, 05 Jun 2011 06:29:20 -0700
Subject: [slime-cvs] CVS slime
Message-ID: <E1QTDOK-0003Ay-Jb@common-lisp.net>

Update of /project/slime/cvsroot/slime
In directory common-lisp.net:/tmp/cvs-serv12207

Modified Files:
	swank-ecl.lisp 
Log Message:
Some changes to the ECL backend so that it works with the new bytecodes compiler.

--- /project/slime/cvsroot/slime/swank-ecl.lisp	2011/01/20 23:34:22	1.68
+++ /project/slime/cvsroot/slime/swank-ecl.lisp	2011/06/05 13:29:19	1.69
@@ -205,6 +205,7 @@
 (defun signal-compiler-condition (&rest args)
   (signal (apply #'make-condition 'compiler-condition args)))
 
+#-ecl-bytecmp
 (defun handle-compiler-message (condition)
   ;; ECL emits lots of noise in compiler-notes, like "Invoking
   ;; external command".
@@ -220,6 +221,7 @@
                  (warning                :warning))
      :location (condition-location condition))))
 
+#-ecl-bytecmp
 (defun condition-location (condition)
   (let ((file     (c:compiler-message-file condition))
         (position (c:compiler-message-file-position condition)))
@@ -232,6 +234,9 @@
         (make-error-location "No location found."))))
 
 (defimplementation call-with-compilation-hooks (function)
+  #-ecl-bytecmp
+  (funcall function)
+  #-ecl-bytecmp
   (handler-bind ((c:compiler-message #'handle-compiler-message))
     (funcall function)))
 




From nsiivola at common-lisp.net  Wed Jun  8 20:44:19 2011
From: nsiivola at common-lisp.net (CVS User nsiivola)
Date: Wed, 08 Jun 2011 13:44:19 -0700
Subject: [slime-cvs] CVS slime/contrib
Message-ID: <E1QUPbv-0006sp-0M@common-lisp.net>

Update of /project/slime/cvsroot/slime/contrib
In directory common-lisp.net:/tmp/cvs-serv26437/contrib

Modified Files:
	ChangeLog slime-cl-indent.el 
Log Message:
slime-indentation: fallback method for trailing expressions on prev line

  Emacs' calculate-lisp-indent doesn't indent

    (foo (or x
             y) t
         z)

  right, but would align Z with Y. Add a fallback method to deal with that.


--- /project/slime/cvsroot/slime/contrib/ChangeLog	2011/06/04 18:20:15	1.464
+++ /project/slime/cvsroot/slime/contrib/ChangeLog	2011/06/08 20:44:18	1.465
@@ -1,3 +1,8 @@
+2011-06-08  Nikodemus Siivola  <nikodemus at random-state.net>
+
+	* slime-cl-indent.el (common-lisp-indent-function-1): fallback
+	method to deal with trailing expressions on the previous line.
+
 2011-06-04  Nikodemus Siivola  <nikodemus at random-state.net>
 
 	* slime-cl-indent.el (toplevel):
--- /project/slime/cvsroot/slime/contrib/slime-cl-indent.el	2011/06/04 18:20:15	1.26
+++ /project/slime/cvsroot/slime/contrib/slime-cl-indent.el	2011/06/08 20:44:18	1.27
@@ -460,8 +460,21 @@
             (condition-case ()
                 (progn (backward-up-list 1)
                        (setq depth (1+ depth)))
-              (error (setq depth lisp-indent-maximum-backtracking))))))
-      (or calculated tentative-calculated))))
+              (error
+               (setq depth lisp-indent-maximum-backtracking))))))
+      (or calculated tentative-calculated
+          ;; Fallback. calculate-lisp-indent doesn't deal with
+          ;; things like (foo (or x
+          ;;                      y) t
+          ;;                  z)
+          ;; but would align the Z with Y.
+          (ignore-errors
+            (save-excursion
+              (goto-char containing-sexp)
+              (down-list)
+              (forward-sexp 2)
+              (backward-sexp)
+              (current-column)))))))
 
 
 (defun common-lisp-indent-call-method (function method path state indent-point
@@ -1378,7 +1391,7 @@
          (lisp-lambda-list-keyword-alignment t))
         "
      (destructuring-bind (foo &optional x
-                                        y 
+                                        y
                               &key bar
                                    quux)
          foo
@@ -1390,7 +1403,12 @@
          (x &optional y
                       z
             &rest more)
-       body)"))))
+       body)")
+       "
+     (foo fii
+          (or x
+              y) t
+          bar)")))
 
 
 




From nsiivola at common-lisp.net  Wed Jun  8 21:04:53 2011
From: nsiivola at common-lisp.net (CVS User nsiivola)
Date: Wed, 08 Jun 2011 14:04:53 -0700
Subject: [slime-cvs] CVS slime/contrib
Message-ID: <E1QUPvp-0000xV-Kb@common-lisp.net>

Update of /project/slime/cvsroot/slime/contrib
In directory common-lisp.net:/tmp/cvs-serv3642/contrib

Modified Files:
	ChangeLog slime-cl-indent.el 
Log Message:
slime-indentation: indirect indentation specs

  Previously, if something was aping the indentation of another form,
  redefinitions weren't being picked up.

  Now, setting the common-lisp-indent-function property of a symbol -- say bar
  -- to: (as foo) means to indent (bar ...)  forms as if they were (foo ...)
  forms.

  If indentation of foo changes, bar will immediately get the new indentation
  as well.


--- /project/slime/cvsroot/slime/contrib/ChangeLog	2011/06/08 20:44:18	1.465
+++ /project/slime/cvsroot/slime/contrib/ChangeLog	2011/06/08 21:04:53	1.466
@@ -1,3 +1,11 @@
+2011-06-09  Nikodemus Siivola  <nikodemus at random-state.net>
+
+	Indirect indentation specs.
+
+	* slime-cl-indent.el (common-lisp-indent-function)
+	(common-lisp-get-indentation, common-lisp-indent-function-1)
+	(lisp-indent-defmethod): Indirect using (as foo) -style specs.
+
 2011-06-08  Nikodemus Siivola  <nikodemus at random-state.net>
 
 	* slime-cl-indent.el (common-lisp-indent-function-1): fallback
--- /project/slime/cvsroot/slime/contrib/slime-cl-indent.el	2011/06/08 20:44:18	1.27
+++ /project/slime/cvsroot/slime/contrib/slime-cl-indent.el	2011/06/08 21:04:53	1.28
@@ -168,6 +168,14 @@
 This applies when the value of the `common-lisp-indent-function' property
 is set to `defun'.")
 
+(defun common-lisp-get-indentation (name)
+  "Retrieves the indentation information for NAME."
+  (let ((method
+         (get name 'common-lisp-indent-function)))
+    (if (and (consp method) (eq 'as (car method)))
+        (common-lisp-get-indentation (cadr method))
+      method)))
+
 ;;;; LOOP indentation, the simple version
 
 (defun common-lisp-loop-type (loop-start)
@@ -257,10 +265,13 @@
   function arguments, and any further arguments like a body.
   This is equivalent to (4 4 ... &body).
 
-* a list.  The list element in position M specifies how to indent the Mth
-  function argument.  If there are fewer elements than function arguments,
-  the last list element applies to all remaining arguments.  The accepted
-  list elements are:
+* a list starting with `as' specifies an indirection: indentation is done as
+  if the form being indented had started with the second element of the list.
+
+* any other list.  The list element in position M specifies how to indent the
+  Mth function argument.  If there are fewer elements than function arguments,
+  the last list element applies to all remaining arguments.  The accepted list
+  elements are:
 
   * nil, meaning the default indentation.
 
@@ -295,7 +306,6 @@
     have an offset of 2+1=3."
   (common-lisp-indent-function-1 indent-point state))
 
-
 (defun common-lisp-indent-function-1 (indent-point state)
   (let ((normal-indent (current-column)))
     ;; Walk up list levels until we see something
@@ -336,17 +346,16 @@
                                         tem (point))))
               (goto-char tem)
               (setq tem (intern-soft function)
-                    method (get tem 'common-lisp-indent-function))
+                    method (common-lisp-get-indentation tem))
               (cond ((and (null method)
                           (string-match ":[^:]+" function))
                      ;; The pleblisp package feature
                      (setq function (substring function
                                                (1+ (match-beginning 0)))
-                           method (get (intern-soft function)
-                                       'common-lisp-indent-function)))
+                           method (common-lisp-get-indentation (intern-soft function))))
                     ((and (null method))
                      ;; backwards compatibility
-                     (setq method (get tem 'lisp-indent-function)))))
+                     (setq method (common-lisp-get-indentation tem)))))
             (let ((n 0))
               ;; How far into the containing form is the current form?
               (if (< (point) indent-point)
@@ -755,7 +764,7 @@
                   (skip-chars-forward " \t\n"))
                 (> nqual 0)))
          (append '(4) (make-list nqual 4) '(&lambda &body))
-         (get 'defun 'common-lisp-indent-function)))
+       (common-lisp-get-indentation 'defun)))
    path state indent-point sexp-column normal-indent))
 
 
@@ -1032,55 +1041,55 @@
 ;;;; Indentation specs for standard symbols, and a few semistandard ones.
 (let ((l '((block 1)
            (case        (4 &rest (&whole 2 &rest 1)))
-           (ccase . case)
-           (ecase . case)
-           (typecase . case)
-           (etypecase . case)
-           (ctypecase . case)
+           (ccase       (as case))
+           (ecase       (as case))
+           (typecase    (as case))
+           (etypecase   (as case))
+           (ctypecase   (as case))
            (catch 1)
            (cond        (&rest (&whole 2 &rest 1)))
            (defvar      (4 2 2))
            (defclass    (6 4 (&whole 2 &rest 1) (&whole 2 &rest 1)))
-           (defconstant . defvar)
+           (defconstant (as defvar))
            (defcustom   (4 2 2 2))
-           (defparameter . defvar)
-           (defconst     . defcustom)
-           (define-condition  . defclass)
+           (defparameter     (as defvar))
+           (defconst         (as defcustom))
+           (define-condition (as defclass))
            (define-modify-macro (4 &lambda &body))
            (defsetf      lisp-indent-defsetf)
            (defun       (4 &lambda &body))
            (defgeneric  (4 &lambda &body))
-           (define-setf-method . defun)
-           (define-setf-expander . defun)
-           (defmacro . defun)
-           (defsubst . defun)
-           (deftype . defun)
+           (define-setf-method   (as defun))
+           (define-setf-expander (as defun))
+           (defmacro     (as defun))
+           (defsubst     (as defun))
+           (deftype      (as defun))
            (defmethod   lisp-indent-defmethod)
            (defpackage  (4 2))
            (defstruct   ((&whole 4 &rest (&whole 2 &rest 1))
                          &rest (&whole 2 &rest 1)))
            (destructuring-bind (&lambda 4 &body))
            (do          lisp-indent-do)
-           (do* . do)
+           (do*         (as do))
            (dolist      ((&whole 4 2 1) &body))
-           (dotimes . dolist)
+           (dotimes     (as dolist))
            (eval-when   1)
            (flet        ((&whole 4 &rest (&whole 1 &lambda &body)) &body))
-           (labels . flet)
-           (macrolet . flet)
-           (generic-flet . flet)
-           (generic-labels . flet)
+           (labels         (as flet))
+           (macrolet       (as flet))
+           (generic-flet   (as flet))
+           (generic-labels (as flet))
            (handler-case (4 &rest (&whole 2 &lambda &body)))
-           (restart-case . handler-case)
+           (restart-case (as handler-case))
            ;; single-else style (then and else equally indented)
            (if          (&rest nil))
            (if*         common-lisp-indent-if*)
            (lambda      (&lambda &rest lisp-indent-function-lambda-hack))
            (let         ((&whole 4 &rest (&whole 1 1 2)) &body))
-           (let* . let)
-           (compiler-let . let) ;barf
-           (handler-bind . let)
-           (restart-bind . let)
+           (let*         (as let))
+           (compiler-let (as let))
+           (handler-bind (as let))
+           (restart-bind (as let))
            (locally 1)
            (loop           lisp-indent-loop)
            (:method (&lambda &body)) ; in `defgeneric'
@@ -1088,35 +1097,42 @@
            (multiple-value-call (4 &body))
            (multiple-value-prog1 1)
            (multiple-value-setq (4 2))
-           (multiple-value-setf . multiple-value-setq)
+           (multiple-value-setf (as multiple-value-setq))
            (named-lambda (4 &lambda &rest lisp-indent-function-lambda-hack))
            (pprint-logical-block (4 2))
            (print-unreadable-object ((&whole 4 1 &rest 1) &body))
            ;; Combines the worst features of BLOCK, LET and TAGBODY
            (prog        (&lambda &rest lisp-indent-tagbody))
-           (prog* . prog)
+           (prog* (as prog))
            (prog1 1)
            (prog2 2)
            (progn 0)
            (progv       (4 4 &body))
            (return 0)
            (return-from (nil &body))
-           (symbol-macrolet . let)
+           (symbol-macrolet (as let))
            (tagbody     lisp-indent-tagbody)
            (throw 1)
            (unless 1)
            (unwind-protect (5 &body))
            (when 1)
-           (with-accessors . multiple-value-bind)
-           (with-condition-restarts . multiple-value-bind)
+           (with-accessors          (as multiple-value-bind))
+           (with-condition-restarts (as multiple-value-bind))
            (with-output-to-string (4 2))
-           (with-slots . multiple-value-bind)
+           (with-slots              (as multiple-value-bind))
            (with-standard-io-syntax (2)))))
   (dolist (el l)
-    (put (car el) 'common-lisp-indent-function
-         (if (symbolp (cdr el))
-             (get (cdr el) 'common-lisp-indent-function)
-             (car (cdr el))))))
+    (let* ((name (car el))
+           (spec (cdr el))
+           (indentation
+            (if (symbolp spec)
+                (error "Old style indirect indentation spec: %s" el)
+              (when (cdr spec)
+                (error "Malformed indentation specification: %s" el))
+              (car spec))))
+      (unless (symbolp name)
+        (error "Cannot set Common Lisp indentation of a non-symbol: %s" name))
+      (put name 'common-lisp-indent-function indentation))))
 
 (defun test-lisp-indent (tests)
   (let ((ok 0))
@@ -1128,7 +1144,7 @@
          (when (cddr test)
            (error "Malformed test: %s" test))
          (dolist (bind (first test))
-           (make-variable-buffer-local (first bind))
+           (make-local-variable (first bind))
            (set (first bind) (second bind)))
          (setf test (second test)))
        (insert test)




From nsiivola at common-lisp.net  Thu Jun  9 11:57:34 2011
From: nsiivola at common-lisp.net (CVS User nsiivola)
Date: Thu, 09 Jun 2011 04:57:34 -0700
Subject: [slime-cvs] CVS slime/contrib
Message-ID: <E1QUdri-00039J-Lx@common-lisp.net>

Update of /project/slime/cvsroot/slime/contrib
In directory common-lisp.net:/tmp/cvs-serv12105/contrib

Modified Files:
	ChangeLog slime-cl-indent.el 
Log Message:
slime-indentation: named Common Lisp styles

 I need to edit files with somewhat different Common Lisp indentation style
 regularly, and I doubt I'm the only one.

 `define-common-lisp-style' can be used to define new styles. If you define
 one that you use in an open-source project, please consider submitting it
 for inclusion.

     * Styles can inherit from each other.

     * Styles can specify buffer local variables.

     * Styles can have custom indentation rules.

     * Styles activation can evaluate code, so they can turn on minor modes,
       etc.

  A style can be specified for a while by doing:

     ;; -*- common-lisp-style: stylename -*=

  Some predefined styles:

     * basic: provides defaults

     * classic: emulates the 1995 vintage indentation from old
       slime-indentation

     * modern: a good pick. Turns on lambda-list smarts, but keeps more
       conservative loop indentation.

     * sbcl: SBCL style. Adds indentation for some SBCL bootstrapping
       constructs, sets indent-tabs-mode to nil, etc.


--- /project/slime/cvsroot/slime/contrib/ChangeLog	2011/06/08 21:04:53	1.466
+++ /project/slime/cvsroot/slime/contrib/ChangeLog	2011/06/09 11:57:34	1.467
@@ -1,5 +1,17 @@
 2011-06-09  Nikodemus Siivola  <nikodemus at random-state.net>
 
+	Support for named styles.
+
+	* slime-cl-indent.el (common-lisp-style)
+	(common-lisp-style-default, common-lisp-active-style)
+	(common-lisp-lisp-mode-hook, common-lisp-styles)
+	(common-lisp-add-style, define-common-lisp-style)
+	(common-lisp-set-style, common-lisp-set-style-history)
+	(common-lisp-activate-style, common-lisp-get-indentation): New
+	functions and variables. Setting `common-lisp-style' buffer local
+	variable in a file picks a style -- or use `common-lisp-set-style"
+	to do it. Indentation from style takes precedence.
+
 	Indirect indentation specs.
 
 	* slime-cl-indent.el (common-lisp-indent-function)
--- /project/slime/cvsroot/slime/contrib/slime-cl-indent.el	2011/06/08 21:04:53	1.28
+++ /project/slime/cvsroot/slime/contrib/slime-cl-indent.el	2011/06/09 11:57:34	1.29
@@ -37,7 +37,6 @@
   "Indentation in Lisp."
   :group 'lisp)
 
-
 (defcustom lisp-indent-maximum-backtracking 3
   "Maximum depth to backtrack out from a sublist for structured indentation.
 If this variable is 0, no backtracking will occur and forms such as `flet'
@@ -168,14 +167,296 @@
 This applies when the value of the `common-lisp-indent-function' property
 is set to `defun'.")
 
+
+;;;; Named styles.
+;;;;
+;;;; -*- common-lisp-style: foo -*-
+;;;;
+;;;; sets the style for the buffer.
+;;;;
+;;;; A Common Lisp style is a list of the form:
+;;;;
+;;;;  (NAME VARIABLES TABLE HOOKS DOCSTRING)
+;;;;
+;;;; where NAME is a symbol naming the style, VARIABLES is an alist specifying
+;;;; buffer local variables for the style, and TABLE is a hashtable specifying
+;;;; non-standard indentations for Common Lisp symbols. HOOKS is a list of
+;;;; functions to call when activating the style. DOCSTRING is the
+;;;; documentation for the style.
+;;;;
+;;;; `common-lisp-style' stores the name of the current style.
+;;;;
+;;;; `common-lisp-default-style' stores the name of the style to use when none
+;;;; has been specified.
+;;;;
+;;;; `common-lisp-active-style' stores the list specifying the current style.
+;;;; Whenever we're indenting, we check that they match -- and update the
+;;;; latter to match the former if necessary.
+;;;;
+;;;; Hence just setting the buffer local common-lisp-style will be enough
+;;;; to have the style take effect. `common-lisp-set-style' can also be called
+;;;; explicitly, however.
+
+(defvar common-lisp-style nil)
+
+;;; `define-common-lisp-style' updates the docstring of `common-lisp-style', using
+;;; this as the base.
+(put 'common-lisp-style 'common-lisp-style-base-doc
+     "Name of the Common Lisp indentation style used in the current buffer.
+Set this by giving eg.
+
+  ;; -*- common-lisp-style: sbcl -*-
+
+in the first line of the file, or by calling `common-lisp-set-style'. If
+buffer has no style specified, but `common-lisp-style-default' is set, that
+style is used instead. Use `define-common-lisp-style' to define new styles.")
+
+(defcustom common-lisp-style-default nil
+    "Name of the Common Lisp indentation style to use in lisp-mode buffers if
+none has been specified."
+  :type 'string
+  :group 'lisp-indent)
+
+;;; Common Lisp indentation style specification for the current buffer.
+(defvar common-lisp-active-style nil)
+
+;;; `lisp-mode' kills all buffer-local variables. Setting the
+;;; `permanent-local' property allows us to retain the style.
+(put 'common-lisp-style 'permanent-local t)
+
+;;; If style is being used, that's a sufficient invitation to snag
+;;; the indentation function.
+(defun common-lisp-lisp-mode-hook ()
+  (let ((style (or common-lisp-style common-lisp-style-default)))
+    (when style
+      (set (make-local-variable 'lisp-indent-function)
+           'common-lisp-indent-function)
+      (common-lisp-set-style style))))
+(add-hook 'lisp-mode-hook 'common-lisp-lisp-mode-hook)
+
+;;; Common Lisp indentation style specifications.
+(defvar common-lisp-styles (make-hash-table :test 'equal))
+
+(defun common-lisp-add-style (stylename base variables indentation hooks documentation)
+  (let* ((style (or (gethash stylename common-lisp-styles)
+                    (let ((new (list (intern stylename)             ; name
+                                     nil                            ; variable bindings
+                                     (make-hash-table :test 'equal) ; indentation table
+                                     nil                            ; hooks
+                                     nil)))                         ; docstring
+                      (puthash stylename new common-lisp-styles)
+                      new)))
+         (base-style (when base
+                       (or (gethash base common-lisp-styles)
+                           (error "Unknown base Common Lisp style: %s" base))))
+         (base-vars (second base-style))
+         (base-methods (third base-style))
+         (base-hooks (fourth base-style)))
+    ;; Variables
+    (setf (second style) variables)
+    (dolist (var base-vars)
+      (unless (assoc (car var) variables)
+        (push var (second style))))
+    ;; Indentation
+    (let ((methods (third style)))
+      (clrhash methods)
+      (when base-methods
+        (maphash (lambda (s m)
+                   (puthash s m methods))
+                 base-methods))
+      (dolist (indent indentation)
+        (let* ((name (car indent))
+               (spec (cdr indent))
+               (method
+                (if (symbolp spec)
+                    (list :as spec)
+                  (when (cdr spec)
+                    (error "Malformed Common Lisp indentation spec: %s" indent))
+                  (car spec))))
+          (puthash name method methods))))
+    ;; Hooks
+    (setf (fourth style) nil)
+    (dolist (hook (reverse base-hooks))
+      (unless (member hook hooks)
+        (push hook (fourth style))))
+    (dolist (hook (reverse hooks))
+      (push hook (fourth style)))
+    ;; Documentation
+    (setf (fifth style) documentation)
+    ;; Frob `common-lisp-style' docstring.
+    (let ((doc (get 'common-lisp-style 'common-lisp-style-base-doc))
+          (all nil))
+      (setq doc (concat doc "\n\nAvailable styles are:\n"))
+      (maphash (lambda (name style)
+                 (push (list name (fifth style)) all))
+               common-lisp-styles)
+      (dolist (info (sort all (lambda (a b) (string< (car a) (car b)))))
+        (let ((style-name (first info))
+              (style-doc (second info)))
+          (if style-doc
+              (setq doc (concat doc
+                                "\n " style-name "\n"
+                                "   " style-doc "\n"))
+                     (setq doc (concat doc
+                                       "\n " style-name " (undocumented)\n")))))
+      (put 'common-lisp-style 'variable-documentation doc))
+    stylename))
+
+(defmacro define-common-lisp-style (name documentation &rest options)
+  "Define a Common Lisp indentation style.
+
+NAME is the name of the style.
+
+DOCUMENTATION is the docstring for the style, automatically added to the
+docstring of `common-lisp-style'.
+
+OPTIONS are:
+
+ (:variables (name value) ...)
+
+  Specifying the buffer local variables associated with the style.
+
+ (:indentation (symbol spec) ...)
+
+  Specifying custom indentations associated with the style. SPEC is
+  a normal `common-lisp-indent-function' indentation specification.
+
+ (:inherit style)
+
+  Inherit variables and indentations from another Common Lisp style.
+
+ (:eval form ...)
+
+  Lisp code to evaluate when activating the style. This can be used to
+  eg. activate other modes.
+"
+  (when (consp documentation)
+    (setq documentation nil
+          options (cons documentation options)))
+  `(common-lisp-add-style ,name
+                          ',(cadr (assoc :inherit options))
+                          ',(cdr (assoc :variables options))
+                          ',(cdr (assoc :indentation options))
+                          ,(when (assoc :eval options)
+                            `(list
+                              (lambda ()
+                                ,@(cdr (assoc :eval options)))))
+                          ,documentation))
+
+(define-common-lisp-style "basic"
+  "This style merely gives all identation variables their default values,
+   making it easy to create new styles that are proof against user
+   customizations."
+  (:variables
+   (lisp-indent-maximum-backtracking 3)
+   (lisp-tag-indentation 1)
+   (lisp-tag-body-indentation 3)
+   (lisp-backquote-indentation t)
+   (lisp-loop-indent-subclauses t)
+   (lisp-loop-indent-forms-like-keywords nil)
+   (lisp-simple-loop-indentation 2)
+   (lisp-align-keywords-in-calls t)
+   (lisp-lambda-list-indentation t)
+   (lisp-lambda-list-keyword-alignment nil)
+   (lisp-lambda-list-keyword-parameter-indentation 2)
+   (lisp-lambda-list-keyword-parameter-alignment nil)
+   (lisp-indent-defun-method (4 &lambda &body))))
+
+(define-common-lisp-style "classic"
+  "This style of indentation emulates the most striking features of 1995
+   vintage cl-indent.el once included as part of Slime: IF indented by two
+   spaces, and CASE clause bodies indentented more deeply than the keys."
+  (:inherit "basic")
+  (:variables
+   (lisp-lambda-list-keyword-parameter-indentation 0))
+  (:indentation
+   (case (4 &rest (&whole 2 &rest 3)))
+   (if   (4 2 2))))
+
+(define-common-lisp-style "modern"
+  "A good general purpose style. Turns on lambda-list keyword and keyword
+   parameter alignment, and turns subclause aware loop indentation off.
+   (Loop indentation so because simpler style is more prevalent in existing
+   sources, not because it is necessarily preferred.)"
+  (:inheric "basic")
+  (:variables
+   (lisp-lambda-list-keyword-alignment t)
+   (lisp-lambda-list-keyword-parameter-alignment t)
+   (lisp-lambda-list-keyword-parameter-indentation 0)
+   (lisp-loop-indent-subclauses nil)))
+
+(define-common-lisp-style "sbcl"
+  "Style used in SBCL sources. A good if somewhat intrusive general purpose
+   style based on the \"modern\" style. Adds indentation for a few SBCL
+   specific constructs, sets indentation to use spaces instead of tabs,
+   fill-column to 78, and activates whitespace-mode to show tabs and trailing
+   whitespace."
+  (:inherit "modern")
+  (:eval
+   (whitespace-mode 1))
+  (:variables
+   (whitespace-style (tabs trailing))
+   (indent-tabs-mode nil)
+   (comment-fill-column nil)
+   (fill-column 78))
+  (:indentation
+   (def!constant       (:as defconstant))
+   (def!macro          (:as defmacro))
+   (def!method         (:as defmethod))
+   (def!struct         (:as defstruct))
+   (def!type           (:as deftype))
+   (defmacro-mundanely (:as defmacro))))
+
+(defvar common-lisp-set-style-history nil)
+
+(defun common-lisp-set-style (stylename)
+  "Set current buffer to use the Common Lisp style STYLENAME.
+STYLENAME, a string, must be an existing Common Lisp style. Styles
+are added (and updated) using `common-lisp-add-style'.
+
+The buffer-local variable `common-lisp-style' will get set to STYLENAME.
+Simply setting
+
+A Common Lisp style is composed of variable and indentation specifications."
+  (interactive
+   (list (let ((completion-ignore-case t)
+               (prompt "Specify Common Lisp indentation style: "))
+           (completing-read prompt
+                            common-lisp-styles nil t nil
+                            'common-lisp-set-style-history))))
+  (let* ((stylename (if (stringp stylename)
+                        stylename
+                      (symbol-name stylename)))
+         (style (or (gethash stylename common-lisp-styles)
+                    (error "Unknown Common Lisp style: %s" stylename))))
+    (common-lisp-activate-style style)))
+
+(defun common-lisp-activate-style (style)
+  (let ((vars (second style))
+        (methods (third style))
+        (hooks (fourth style)))
+    (dolist (var vars)
+      (set (make-local-variable (car var)) (cadr var)))
+    (dolist (hook hooks)
+      (funcall hook))
+    (set (make-local-variable 'common-lisp-style) (car style))
+    (set (make-local-variable 'common-lisp-active-style) style)))
+
+;;;; The indentation specs are stored at two levels: the global defaults
+;;;; live in symbol properties: how to indent `foo' is stored in the
+;;;; `common-lisp-indent-function' property of `foo'.
+;;;;
+;;;; When a specific style is in use, we first look in its method table.
 (defun common-lisp-get-indentation (name)
   "Retrieves the indentation information for NAME."
   (let ((method
-         (get name 'common-lisp-indent-function)))
+         (or (when common-lisp-active-style
+               (gethash name (third common-lisp-active-style)))
+             (get name 'common-lisp-indent-function))))
     (if (and (consp method) (eq 'as (car method)))
         (common-lisp-get-indentation (cadr method))
       method)))
-
+
 ;;;; LOOP indentation, the simple version
 
 (defun common-lisp-loop-type (loop-start)




From nsiivola at common-lisp.net  Thu Jun  9 16:35:09 2011
From: nsiivola at common-lisp.net (CVS User nsiivola)
Date: Thu, 09 Jun 2011 09:35:09 -0700
Subject: [slime-cvs] CVS slime
Message-ID: <E1QUiCL-0004RY-Du@common-lisp.net>

Update of /project/slime/cvsroot/slime
In directory common-lisp.net:/tmp/cvs-serv17070

Modified Files:
	ChangeLog slime.el swank.lisp 
Log Message:
slime-indentation: per-package indentation from swank

  SWANK sends indentation information for macro-lambda lists
  to the Emacs side.

  Prior to this, however, this was a lossy N->1 mapping, where different
  symbols with the same name from multiple packages were conflated.

  Now an indentation update also includes a list of packages where the symbol
  in question is accessible.

  If slime-indentation is not being used, this information is dropped by Emacs.

  If, however, slime-indentation is used, the package information is stored in
  common-lisp-system-indentation hash-table, which is used as a fallback when
  indentation from other sources is not available for the symbol in question.

  Package used for looking up the indentation spec is either picked up from
  the package qualifier in the source, or guessed from the buffer.


--- /project/slime/cvsroot/slime/ChangeLog	2011/05/27 07:45:44	1.2195
+++ /project/slime/cvsroot/slime/ChangeLog	2011/06/09 16:35:09	1.2196
@@ -1,3 +1,19 @@
+2011-06-09  Nikodemus Siivola  <nikodemus at random-state.net>
+
+	Support for per-package derived indentation, when
+	slime-indentation is used.
+
+	* swank.lisp (update-indentation/delta-for-emacs): Tell Emacs
+	which packages the symbol is available in. Unless
+	slime-indentation is used, this information is just dropped on the
+	floor.
+
+	* slime.el (slime-update-system-indentation): New function. Use
+	this to inform indentation about derived specs when
+	`common-lisp-system-indentation' is bound.
+	(slime-handle-indentation-update): Adjust to support per-package
+	derived indentation specs when slime-indentation is available.
+
 2011-05-27  Helmut Eller  <heller at common-lisp.net>
 
 	Fix "wrong number of args" problem with slime-inspector-quit.
--- /project/slime/cvsroot/slime/slime.el	2011/05/27 07:45:44	1.1370
+++ /project/slime/cvsroot/slime/slime.el	2011/06/09 16:35:09	1.1371
@@ -6932,6 +6932,21 @@
         (t
          spec)))
 
+(defun slime-update-system-indentation (symbol indent packages)
+  (let ((list (gethash symbol common-lisp-system-indentation)))
+    (if (not list)
+        (puthash symbol (list (cons indent packages))
+                 common-lisp-system-indentation)
+      (or (dolist (spec list)
+            (when (equal (car spec) indent)
+              (dolist (p packages)
+                (unless (member p (cdr spec))
+                  (push p (cdr spec))))
+              (return t)))
+          (puthash symbol (cons (cons indent packages)
+                                list)
+                   common-lisp-system-indentation)))))
+
 (defun slime-handle-indentation-update (alist)
   "Update Lisp indent information.
 
@@ -6940,13 +6955,17 @@
 is setup, unless the user already set one explicitly."
   (dolist (info alist)
     (let ((symbol (intern (car info)))
-          (indent (slime-intern-indentation-spec (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 'common-lisp-indent-function indent)
-        (put symbol 'slime-indent indent))
-      (run-hook-with-args 'slime-indentation-update-hooks symbol indent))))
+          (indent (slime-intern-indentation-spec (second info)))
+          (packages (third info)))
+      (if (boundp 'common-lisp-system-indentation)
+          ;; A table provided by slime-cl-indent.el.
+          (slime-update-system-indentation symbol indent packages)
+        ;; 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 'slime-indent indent)))
+      (run-hook-with-args 'slime-indentation-update-hooks symbol indent packages))))
 
 
 ;;;; Contrib modules
--- /project/slime/cvsroot/slime/swank.lisp	2011/05/23 22:51:46	1.743
+++ /project/slime/cvsroot/slime/swank.lisp	2011/06/09 16:35:09	1.744
@@ -3893,16 +3893,20 @@
         (send-to-emacs (list :indentation-update delta))))))
 
 (defun update-indentation/delta-for-emacs (cache &optional force)
-  "Update the cache and return the changes in a (SYMBOL . INDENT) list.
+  "Update the cache and return the changes in a (SYMBOL INDENT PACKAGES) list.
 If FORCE is true then check all symbols, otherwise only check symbols
 belonging to the buffer package."
   (let ((alist '()))
-      (flet ((consider (symbol)
+    (flet ((consider (symbol)
              (let ((indent (symbol-indentation symbol)))
                (when indent
                  (unless (equal (gethash symbol cache) indent)
                    (setf (gethash symbol cache) indent)
-                   (push (cons (string-downcase symbol) indent) alist))))))
+                   (let ((pkgs (loop for p in (list-all-packages)
+                                     when (eq symbol (find-symbol (string symbol) p))
+                                     collect (package-name p)))
+                         (name (string-downcase symbol)))
+                     (push (list name indent pkgs) alist)))))))
       (if force
           (do-all-symbols (symbol)
             (consider symbol))




From nsiivola at common-lisp.net  Thu Jun  9 16:35:09 2011
From: nsiivola at common-lisp.net (CVS User nsiivola)
Date: Thu, 09 Jun 2011 09:35:09 -0700
Subject: [slime-cvs] CVS slime/contrib
Message-ID: <E1QUiCL-0004Ru-Lk@common-lisp.net>

Update of /project/slime/cvsroot/slime/contrib
In directory common-lisp.net:/tmp/cvs-serv17070/contrib

Modified Files:
	ChangeLog slime-cl-indent.el slime-indentation.el 
Log Message:
slime-indentation: per-package indentation from swank

  SWANK sends indentation information for macro-lambda lists
  to the Emacs side.

  Prior to this, however, this was a lossy N->1 mapping, where different
  symbols with the same name from multiple packages were conflated.

  Now an indentation update also includes a list of packages where the symbol
  in question is accessible.

  If slime-indentation is not being used, this information is dropped by Emacs.

  If, however, slime-indentation is used, the package information is stored in
  common-lisp-system-indentation hash-table, which is used as a fallback when
  indentation from other sources is not available for the symbol in question.

  Package used for looking up the indentation spec is either picked up from
  the package qualifier in the source, or guessed from the buffer.


--- /project/slime/cvsroot/slime/contrib/ChangeLog	2011/06/09 11:57:34	1.467
+++ /project/slime/cvsroot/slime/contrib/ChangeLog	2011/06/09 16:35:09	1.468
@@ -1,5 +1,20 @@
 2011-06-09  Nikodemus Siivola  <nikodemus at random-state.net>
 
+	Support for per-package derived indentation.
+
+	* slime-cl-indent.el (common-lisp-system-indentation)
+	(common-lisp-guess-current-package)
+	(common-lisp-current-package-function)
+	(common-lisp-symbol-package): New variables and functions.
+	(common-lisp-get-indentation): Adjust to use system derived
+	information when available.
+	(common-lisp-indent-function-1): Adust to provide
+	`common-lisp-get-indentation' with the full symbol incl.
+	package prefix.
+
+	* slime-indentation.el (common-lisp-current-package-function): set
+	to `slime-current-package'.
+
 	Support for named styles.
 
 	* slime-cl-indent.el (common-lisp-style)
--- /project/slime/cvsroot/slime/contrib/slime-cl-indent.el	2011/06/09 11:57:34	1.29
+++ /project/slime/cvsroot/slime/contrib/slime-cl-indent.el	2011/06/09 16:35:09	1.30
@@ -442,17 +442,82 @@
     (set (make-local-variable 'common-lisp-style) (car style))
     (set (make-local-variable 'common-lisp-active-style) style)))
 
-;;;; The indentation specs are stored at two levels: the global defaults
-;;;; live in symbol properties: how to indent `foo' is stored in the
-;;;; `common-lisp-indent-function' property of `foo'.
+;;;; The indentation specs are stored at three levels. In order of priority:
 ;;;;
-;;;; When a specific style is in use, we first look in its method table.
-(defun common-lisp-get-indentation (name)
+;;;; 1. Indentation as set by current style, from the indentation table
+;;;;    in the current style.
+;;;;
+;;;; 2. Globally set indentation, from the `common-lisp-indent-function'
+;;;;    property of the symbol.
+;;;;
+;;;; 3. Per-package indentation derived by the system. A live Common Lisp
+;;;;    system may (via Slime, eg.) add indentation specs to
+;;;;    common-lisp-system-indentation, where they are associated with
+;;;;    the package of the symbol. Then we run some lossy heuristics and
+;;;;    find something that looks promising.
+;;;;
+;;;;    FIXME: for non-system packages the derived indentation should probably
+;;;;    take precedence.
+
+;;; This maps symbols into lists of (INDENT . PACKAGES) where INDENT is
+;;; an indentation spec, and PACKAGES are the names of packages where this
+;;; applies.
+;;;
+;;; We never add stuff here by ourselves: this is for things like Slime to
+;;; fill.
+(defvar common-lisp-system-indentation (make-hash-table :test 'equal))
+
+(defun common-lisp-guess-current-package ()
+  (let (pkg)
+    (save-excursion
+      (ignore-errors
+        (when (let ((case-fold-search t))
+                (search-backward "(in-package "))
+          (re-search-forward "[ :\"]+")
+          (let ((start (point)))
+            (re-search-forward "[\":)]")
+            (setf pkg (upcase (buffer-substring-no-properties start (1- (point)))))))))
+    pkg))
+
+(defun common-lisp-current-package-function 'common-lisp-guess-current-package
+  "Function used to the derive the package name to use for indentation at a
+given point. Defaults to `common-lisp-guess-current-package'.")
+
+(defun common-lisp-symbol-package (string)
+  (if (and (stringp string) (string-match ":" string))
+      (let ((p (match-beginning 0)))
+        (if (eql 0 p)
+            "KEYWORD"
+          (upcase (substring string 0 p))))
+    (funcall common-lisp-current-package-function)))
+
+(defun common-lisp-get-indentation (name &optional full)
   "Retrieves the indentation information for NAME."
   (let ((method
-         (or (when common-lisp-active-style
-               (gethash name (third common-lisp-active-style)))
-             (get name 'common-lisp-indent-function))))
+         (or
+          ;; From style
+          (when common-lisp-active-style
+            (gethash name (third common-lisp-active-style)))
+          ;; From global settings.
+          (get name 'common-lisp-indent-function)
+          ;; From system derived information.
+          (let ((system-info (gethash name common-lisp-system-indentation)))
+            (if (not (cdr system-info))
+                (caar system-info)
+              (let ((guess nil)
+                    (guess-n 0)
+                    (package (common-lisp-symbol-package full)))
+                (dolist (info system-info guess)
+                  (let* ((pkgs (cdr info))
+                         (n (length pkgs)))
+                    (cond ((member package pkgs)
+                           ;; This is it.
+                           (return (car info)))
+                          ((> n guess-n)
+                           ;; If we can't find the real thing, go with the one
+                           ;; accessible in most packages.
+                           (setf guess (car info)
+                                 guess-n n)))))))))))
     (if (and (consp method) (eq 'as (car method)))
         (common-lisp-get-indentation (cadr method))
       method)))
@@ -617,14 +682,15 @@
           (forward-char 1)
           (parse-partial-sexp (point) indent-point 1 t)
           ;; Move to the car of the relevant containing form
-          (let (tem function method tentative-defun)
+          (let (tem full function method tentative-defun)
             (if (not (looking-at "\\sw\\|\\s_"))
                 ;; This form doesn't seem to start with a symbol
-                (setq function nil method nil)
+                (setq function nil method nil full nil)
               (setq tem (point))
               (forward-sexp 1)
-              (setq function (downcase (buffer-substring-no-properties
-                                        tem (point))))
+              (setq full (downcase (buffer-substring-no-properties
+                                        tem (point)))
+                    function full)
               (goto-char tem)
               (setq tem (intern-soft function)
                     method (common-lisp-get-indentation tem))
@@ -633,7 +699,7 @@
                      ;; The pleblisp package feature
                      (setq function (substring function
                                                (1+ (match-beginning 0)))
-                           method (common-lisp-get-indentation (intern-soft function))))
+                           method (common-lisp-get-indentation (intern-soft function) full)))
                     ((and (null method))
                      ;; backwards compatibility
                      (setq method (common-lisp-get-indentation tem)))))
--- /project/slime/cvsroot/slime/contrib/slime-indentation.el	2011/05/15 17:05:22	1.7
+++ /project/slime/cvsroot/slime/contrib/slime-indentation.el	2011/06/09 16:35:09	1.8
@@ -5,4 +5,6 @@
 
 (load "slime-cl-indent.el")
 
+(setq common-lisp-current-package-function 'slime-current-package)
+
 (provide 'slime-indentation)




From nsiivola at common-lisp.net  Thu Jun  9 16:53:56 2011
From: nsiivola at common-lisp.net (CVS User nsiivola)
Date: Thu, 09 Jun 2011 09:53:56 -0700
Subject: [slime-cvs] CVS slime/contrib
Message-ID: <E1QUiUW-0004ca-4j@common-lisp.net>

Update of /project/slime/cvsroot/slime/contrib
In directory common-lisp.net:/tmp/cvs-serv17764/contrib

Modified Files:
	slime-cl-indent.el 
Log Message:
fix typo in define-common-lisp-style "modern"

--- /project/slime/cvsroot/slime/contrib/slime-cl-indent.el	2011/06/09 16:35:09	1.30
+++ /project/slime/cvsroot/slime/contrib/slime-cl-indent.el	2011/06/09 16:53:56	1.31
@@ -378,7 +378,7 @@
    parameter alignment, and turns subclause aware loop indentation off.
    (Loop indentation so because simpler style is more prevalent in existing
    sources, not because it is necessarily preferred.)"
-  (:inheric "basic")
+  (:inherit "basic")
   (:variables
    (lisp-lambda-list-keyword-alignment t)
    (lisp-lambda-list-keyword-parameter-alignment t)




From nsiivola at common-lisp.net  Thu Jun  9 16:58:09 2011
From: nsiivola at common-lisp.net (CVS User nsiivola)
Date: Thu, 09 Jun 2011 09:58:09 -0700
Subject: [slime-cvs] CVS slime/contrib
Message-ID: <E1QUiYb-0004qH-1N@common-lisp.net>

Update of /project/slime/cvsroot/slime/contrib
In directory common-lisp.net:/tmp/cvs-serv18612/contrib

Modified Files:
	ChangeLog slime-cl-indent.el 
Log Message:
fix lisp-lambda-list-keyword-parameter-alignement docstring

--- /project/slime/cvsroot/slime/contrib/ChangeLog	2011/06/09 16:35:09	1.468
+++ /project/slime/cvsroot/slime/contrib/ChangeLog	2011/06/09 16:58:08	1.469
@@ -1,5 +1,8 @@
 2011-06-09  Nikodemus Siivola  <nikodemus at random-state.net>
 
+	* slime-cl-indent.el (lisp-lambda-list-keyword-parameter-alignment):
+	fix docstring: key1 and key3 were aligned in source, but not in *Help*.
+
 	Support for per-package derived indentation.
 
 	* slime-cl-indent.el (common-lisp-system-indentation)
--- /project/slime/cvsroot/slime/contrib/slime-cl-indent.el	2011/06/09 16:53:56	1.31
+++ /project/slime/cvsroot/slime/contrib/slime-cl-indent.el	2011/06/09 16:58:09	1.32
@@ -156,7 +156,7 @@
 \(or falls back to the previous case), as in:
 
 \(defun foo (arg1 arg2 &key key1 key2
-                            key3 key4)
+                           key3 key4)
   #|...|#)"
   :type 'boolean
   :group 'lisp-indent)




From nsiivola at common-lisp.net  Thu Jun  9 17:48:47 2011
From: nsiivola at common-lisp.net (CVS User nsiivola)
Date: Thu, 09 Jun 2011 10:48:47 -0700
Subject: [slime-cvs] CVS slime
Message-ID: <E1QUjLb-0003vh-5E@common-lisp.net>

Update of /project/slime/cvsroot/slime
In directory common-lisp.net:/tmp/cvs-serv15100

Modified Files:
	ChangeLog swank-sbcl.lisp 
Log Message:
fix swank-sbcl.lisp execv -- sb-posix:syscall-error broke backwards compatibility

--- /project/slime/cvsroot/slime/ChangeLog	2011/06/09 16:35:09	1.2196
+++ /project/slime/cvsroot/slime/ChangeLog	2011/06/09 17:48:47	1.2197
@@ -1,5 +1,10 @@
 2011-06-09  Nikodemus Siivola  <nikodemus at random-state.net>
 
+	* swank-sbcl.lisp (execv): Stupid SBCL hackers breaking backwards
+	compatibility again: SB-POSIX:SYSCALL-ERROR has a required
+	argument in 1.0.49, but accepts no arguments in older ones. Use
+	plain ERROR instead.
+
 	Support for per-package derived indentation, when
 	slime-indentation is used.
 
--- /project/slime/cvsroot/slime/swank-sbcl.lisp	2011/05/09 10:48:10	1.280
+++ /project/slime/cvsroot/slime/swank-sbcl.lisp	2011/06/09 17:48:47	1.281
@@ -1584,10 +1584,10 @@
 
 #+unix
 (progn
-  (sb-alien:define-alien-routine ("execv" sys-execv) sb-alien:int 
+  (sb-alien:define-alien-routine ("execv" sys-execv) sb-alien:int
     (program sb-alien:c-string)
     (argv (* sb-alien:c-string)))
-  
+
   (defun execv (program args)
     "Replace current executable with another one."
     (let ((a-args (sb-alien:make-alien sb-alien:c-string
@@ -1600,7 +1600,7 @@
                             item))
              (when (minusp
                     (sys-execv program a-args))
-               (sb-posix:syscall-error)))
+               (error "execv(3) returned.")))
         (sb-alien:free-alien a-args))))
 
   (defun runtime-pathname ()




From nsiivola at common-lisp.net  Thu Jun  9 20:47:46 2011
From: nsiivola at common-lisp.net (CVS User nsiivola)
Date: Thu, 09 Jun 2011 13:47:46 -0700
Subject: [slime-cvs] CVS slime/contrib
Message-ID: <E1QUm8o-0005K2-KU@common-lisp.net>

Update of /project/slime/cvsroot/slime/contrib
In directory common-lisp.net:/tmp/cvs-serv20453/contrib

Modified Files:
	ChangeLog slime-cl-indent.el 
Log Message:
slime-indentation: bugfix in fallback method

--- /project/slime/cvsroot/slime/contrib/ChangeLog	2011/06/09 16:58:08	1.469
+++ /project/slime/cvsroot/slime/contrib/ChangeLog	2011/06/09 20:47:46	1.470
@@ -2,6 +2,9 @@
 
 	* slime-cl-indent.el (lisp-lambda-list-keyword-parameter-alignment):
 	fix docstring: key1 and key3 were aligned in source, but not in *Help*.
+	(common-lisp-delete-style): Missing function, needed by tests.
+	(common-lisp-indent-function-1, run-lisp-indent-tests): Fix fallback
+	to handle case of first function argument on its own line.
 
 	Support for per-package derived indentation.
 
--- /project/slime/cvsroot/slime/contrib/slime-cl-indent.el	2011/06/09 16:58:09	1.32
+++ /project/slime/cvsroot/slime/contrib/slime-cl-indent.el	2011/06/09 20:47:46	1.33
@@ -237,6 +237,9 @@
 ;;; Common Lisp indentation style specifications.
 (defvar common-lisp-styles (make-hash-table :test 'equal))
 
+(defun common-lisp-delete-style (stylename)
+  (remhash stylename common-lisp-styles))
+
 (defun common-lisp-add-style (stylename base variables indentation hooks documentation)
   (let* ((style (or (gethash stylename common-lisp-styles)
                     (let ((new (list (intern stylename)             ; name
@@ -826,11 +829,15 @@
           ;; but would align the Z with Y.
           (ignore-errors
             (save-excursion
-              (goto-char containing-sexp)
-              (down-list)
-              (forward-sexp 2)
-              (backward-sexp)
-              (current-column)))))))
+              (goto-char indent-point)
+              (back-to-indentation)
+              (let ((p (point)))
+                (goto-char containing-sexp)
+                (down-list)
+                (forward-sexp 2)
+                (backward-sexp)
+                (unless (= p (point))
+                  (current-column)))))))))
 
 
 (defun common-lisp-indent-call-method (function method path state indent-point
@@ -1771,7 +1778,10 @@
      (foo fii
           (or x
               y) t
-          bar)")))
+          bar)"
+       "
+      (foo
+       (bar))")))
 
 
 




From nsiivola at common-lisp.net  Fri Jun 10 14:18:39 2011
From: nsiivola at common-lisp.net (CVS User nsiivola)
Date: Fri, 10 Jun 2011 07:18:39 -0700
Subject: [slime-cvs] CVS slime/contrib
Message-ID: <E1QV2Xn-0004f6-Vo@common-lisp.net>

Update of /project/slime/cvsroot/slime/contrib
In directory common-lisp.net:/tmp/cvs-serv17912/contrib

Modified Files:
	ChangeLog slime-cl-indent.el 
Added Files:
	slime-cl-indent-test.txt 
Log Message:
slime-indentation: refactor tests

  Move all test-cases to a new file: slime-cl-indent-test.txt.


--- /project/slime/cvsroot/slime/contrib/ChangeLog	2011/06/09 20:47:46	1.470
+++ /project/slime/cvsroot/slime/contrib/ChangeLog	2011/06/10 14:18:39	1.471
@@ -1,3 +1,13 @@
+2011-06-10  Nikodemus Siivola  <nikodemus at random-state.net>
+
+	* slime-cl-indent.el (common-lisp-indent-test): replaces
+	test-lisp-indent.
+	(common-lisp-run-indentation-tests): replaces
+	run-lisp-indent-tests.
+
+	* slime-cl-indent-test.txt: new file, contains all the indentation
+	tests.
+
 2011-06-09  Nikodemus Siivola  <nikodemus at random-state.net>
 
 	* slime-cl-indent.el (lisp-lambda-list-keyword-parameter-alignment):
--- /project/slime/cvsroot/slime/contrib/slime-cl-indent.el	2011/06/09 20:47:46	1.33
+++ /project/slime/cvsroot/slime/contrib/slime-cl-indent.el	2011/06/10 14:18:39	1.34
@@ -1488,315 +1488,80 @@
         (error "Cannot set Common Lisp indentation of a non-symbol: %s" name))
       (put name 'common-lisp-indent-function indentation))))
 
-(defun test-lisp-indent (tests)
-  (let ((ok 0))
-    (dolist (test tests)
-     (with-temp-buffer
-       (lisp-mode)
-       (setq indent-tabs-mode nil)
-       (when (consp test)
-         (when (cddr test)
-           (error "Malformed test: %s" test))
-         (dolist (bind (first test))
-           (make-local-variable (first bind))
-           (set (first bind) (second bind)))
-         (setf test (second test)))
-       (insert test)
-       (goto-char 0)
-       (skip-chars-forward " \t\n")
-       ;; Mess up the indentation so we know reindentation works
-       (let ((mess nil))
-         (save-excursion
-           (while (not (eobp))
-             (forward-line 1)
-             (ignore-errors (delete-char 1) (setf mess t))))
-         (if (or (not mess) (equal (buffer-string) test))
-             (error "Couldn't mess up indentation?")))
-       (indent-sexp)
-       (if (equal (buffer-string) test)
-           (incf ok)
-           (error "Bad indentation.\nWanted: %s\nGot: %s"
-                  test
-                  (buffer-string)))))
-    ok))
+(defun common-lisp-indent-test (name bindings test)
+  (with-temp-buffer
+    (lisp-mode)
+    (setq indent-tabs-mode nil)
+    (common-lisp-set-style "common-lisp-indent-test")
+    (dolist (bind bindings)
+      (set (make-local-variable (car bind)) (cdr bind)))
+    (insert test)
+    (goto-char 0)
+    ;; Find the first line with content.
+    (skip-chars-forward " \t\n\r")
+    ;; Mess up the indentation so we know reindentation works
+    (save-excursion
+      (while (not (eobp))
+        (forward-line 1)
+        (unless (looking-at "^$")
+          (case (random 2)
+            (0
+             ;; Delete all leading whitespace.
+             (while (looking-at " ") (delete-char 1)))
+            (1
+             ;; Insert whitespace random.
+             (let ((n (1+ (random 24))))
+               (while (> n 0) (decf n) (insert " "))))))))
+    (let ((mess (buffer-string)))
+      (when (equal mess test)
+        (error "Could not mess up indentation?"))
+      (indent-sexp)
+      (if (equal (buffer-string) test)
+          t
+        (error "Bad indentation in test %s.\nMess: %s\nWanted: %s\nGot: %s"
+               name
+               mess
+               test
+               (buffer-string))))))
+
+(defun common-lisp-run-indentation-tests ()
+  (with-temp-buffer
+    (insert-file "slime-cl-indent-test.txt")
+    (goto-char 0)
+    (let ((test-mark ";;; Test: ")
+          (n 0))
+      (while (not (eobp))
+        (if (looking-at test-mark)
+            (let* ((name-start (progn (search-forward ": ") (point)))
+                   (name-end (progn (end-of-line) (point)))
+                   (test-name
+                    (buffer-substring-no-properties name-start name-end))
+                   (bindings nil))
+              (forward-line 1)
+              (while (looking-at ";")
+                (when (looking-at ";; ")
+                  (skip-chars-forward "; ")
+                  (unless (eolp)
+                    (let* ((var-start (point))
+                           (val-start (progn (search-forward ": ") (point)))
+                           (var
+                            (intern (buffer-substring-no-properties
+                                     var-start (- val-start 2))))
+                           (val
+                            (car (read-from-string
+                                  (buffer-substring-no-properties
+                                   val-start (progn (end-of-line) (point)))))))
+                      (push (cons var val) bindings))))
+                (forward-line 1))
+              (let ((test-start (point)))
+                (while (not (or (eobp) (looking-at test-mark)))
+                  (forward-line 1))
+                (let ((test (buffer-substring-no-properties test-start (point))))
+                  (common-lisp-indent-test test-name bindings test)
+                  (incf n))))
+          (forward-line 1)))
+      (message "%s tests OK." n))))
 
-;; (run-lisp-indent-tests)
-
-(defun run-lisp-indent-tests ()
-  (test-lisp-indent
-   '("
- (defun foo ()
-   t)"
-     (((lisp-lambda-list-keyword-parameter-alignment nil)
-       (lisp-lambda-list-keyword-alignment nil))
-      "
- (defun foo (foo &optional opt1
-                   opt2
-             &rest rest)
-   (list foo opt1 opt2
-         rest))")
-     (((lisp-lambda-list-keyword-parameter-alignment t)
-       (lisp-lambda-list-keyword-alignment nil))
-      "
- (defun foo (foo &optional opt1
-                           opt2
-             &rest rest)
-   (list foo opt1 opt2
-         rest))")
-     (((lisp-lambda-list-keyword-parameter-alignment nil)
-       (lisp-lambda-list-keyword-alignment t))
-      "
- (defun foo (foo &optional opt1
-                   opt2
-                 &rest rest)
-   (list foo opt1 opt2
-         rest))")
-     (((lisp-lambda-list-keyword-parameter-alignment t)
-       (lisp-lambda-list-keyword-alignment t))
-      "
- (defun foo (foo &optional opt1
-                           opt2
-                 &rest rest)
-   (list foo opt1 opt2
-         rest))")
-     (((lisp-lambda-list-keyword-parameter-alignment nil)
-       (lisp-lambda-list-keyword-alignment nil))
-      "
- (defmacro foo ((foo &optional opt1
-                       opt2
-                 &rest rest))
-   (list foo opt1 opt2
-         rest))")
-     (((lisp-lambda-list-keyword-parameter-alignment t)
-       (lisp-lambda-list-keyword-alignment nil))
-      "
- (defmacro foo ((foo &optional opt1
-                               opt2
-                 &rest rest))
-   (list foo opt1 opt2
-         rest))")
-     (((lisp-lambda-list-keyword-parameter-alignment nil)
-       (lisp-lambda-list-keyword-alignment t))
-      "
- (defmacro foo ((foo &optional opt1
-                       opt2
-                     &rest rest))
-   (list foo opt1 opt2
-         rest))")
-     (((lisp-lambda-list-keyword-parameter-alignment t)
-       (lisp-lambda-list-keyword-alignment t))
-      "
- (defmacro foo ((foo &optional opt1
-                               opt2
-                     &rest rest))
-   (list foo opt1 opt2
-         rest))")
-     "
-  (let ((x y)
-        (foo #-foo (no-foo)
-             #+foo (yes-foo))
-        (bar #-bar
-             (no-bar)
-             #+bar
-             (yes-bar)))
-    (list foo bar
-          x))"
-     (((lisp-loop-indent-subclauses t))
-      "
-  (loop for i from 0 below 2
-        for j from 0 below 2
-        when foo
-          do (fubar)
-             (bar)
-             (moo)
-          and collect cash
-                into honduras
-        else do ;; this is the body of the first else
-                ;; the body is ...
-                (indented to the above comment)
-                (ZMACS gets this wrong)
-             and do this
-             and do that
-             and when foo
-                   do the-other
-                   and cry
-        when this-is-a-short-condition do
-          (body code of the when)
-        when here's something I used to botch do (here is a body)
-                                                 (rest of body indented same)
-        do
-           (exdented loop body)
-           (I'm not sure I like this but it's compatible)
-        when funny-predicate do ;; Here's a comment
-                                (body filled to comment))")
-     "
-  (defun foo (x)
-    (tagbody
-     foo
-       (bar)
-     baz
-       (when (losing)
-         (with-big-loser
-             (yow)
-           ((lambda ()
-              foo)
-            big)))
-       (flet ((foo (bar baz zap)
-                (zip))
-              (zot ()
-                quux))
-         (do ()
-             ((lose)
-              (foo 1))
-           (quux)
-          foo
-           (lose))
-         (cond ((x)
-                (win 1 2
-                     (foo)))
-               (t
-                (lose
-                 3))))))"
-     "
-  (if* (eq t nil)
-     then ()
-          ()
-   elseif (dsf)
-     thenret x
-     else (balbkj)
-          (sdf))"
-     "
-   (list foo #+foo (foo)
-             #-foo (no-foo))"
-     (((lisp-loop-indent-subclauses t))
-      "
-    (loop for x in foo1
-          for y in quux1
-          )")
-     (((lisp-loop-indent-subclauses nil))
-      "
-    (loop for x in foo
-          for y in quux
-          )")
-     (((lisp-loop-indent-subclauses nil)
-       (lisp-loop-indent-forms-like-keywords t))
-      "
-   (loop for x in foo
-         for y in quux
-         finally (foo)
-                 (fo)
-                 (zoo)
-         do
-         (print x)
-         (print y)
-         (print 'ok!))")
-     (((lisp-loop-indent-subclauses nil)
-       (lisp-loop-indent-forms-like-keywords nil))
-       "
-   (loop for x in foo
-         for y in quux
-         finally (foo)
-                 (fo)
-                 (zoo)
-         do
-            (print x)
-            (print y)
-            (print 'ok!))")
-      (((lisp-loop-indent-subclauses t)
-        (lisp-loop-indent-forms-like-keywords nil))
-       "
-   (loop for x in foo
-         for y in quux
-         finally (foo)
-                 (fo)
-         do
-            (print x)
-            (print y)
-            (print 'ok!))")
-     (((lisp-loop-indent-subclauses nil)
-       (lisp-loop-indent-forms-like-keywords nil))
-       "
-   (loop for f in files
-         collect (open f
-                       :direction :output)
-         do (foo) (bar)
-            (quux))")
-      (((lisp-loop-indent-subclauses t))
-       "
-   (loop for f in files
-         collect (open f
-                       :direction :output)
-         do (foo) (bar)
-            (quux))")
-       "
-   (defsetf foo bar
-     \"the doc string\")"
-       "
-   (defsetf foo
-       bar
-     \"the doc string\")"
-       (((lisp-lambda-list-keyword-parameter-alignment t))
-        "
-   (defsetf foo (x y &optional a
-                               z)
-       (a b c)
-     stuff)")
-       (((lisp-align-keywords-in-calls t))
-        "
-    (make-instance 'foo :bar t quux t
-                        :zot t)")
-       (((lisp-align-keywords-in-calls nil))
-        "
-    (make-instance 'foo :bar t quux t
-                   :zot t)")
-       (((lisp-lambda-list-indentation nil))
-        "
-      (defun example (a b &optional o1 o2
-                      o3 o4
-                      &rest r
-                      &key k1 k2
-                      k3 k4)
-        'hello)")
-       (((lisp-lambda-list-keyword-parameter-alignment t)
-         (lisp-lambda-list-keyword-alignment t))
-        "
-     (destructuring-bind (foo &optional x
-                                        y
-                              &key bar
-                                   quux)
-         foo
-       body)")
-       (((lisp-lambda-list-keyword-parameter-alignment t)
-         (lisp-lambda-list-keyword-alignment t))
-        "
-     (named-lambda foo
-         (x &optional y
-                      z
-            &rest more)
-       body)")
-       "
-     (foo fii
-          (or x
-              y) t
-          bar)"
-       "
-      (foo
-       (bar))")))
-
-
-
-;(put 'while    'common-lisp-indent-function 1)
-;(put 'defwrapper'common-lisp-indent-function ...)
-;(put 'def 'common-lisp-indent-function ...)
-;(put 'defflavor        'common-lisp-indent-function ...)
-;(put 'defsubst 'common-lisp-indent-function ...)
-
-;(put 'with-restart 'common-lisp-indent-function '((1 4 ((* 1))) (2 &body)))
-;(put 'restart-case 'common-lisp-indent-function '((1 4) (* 2 ((0 1) (* 1)))))
-;(put 'define-condition 'common-lisp-indent-function '((1 6) (2 6 ((&whole 1))) (3 4 ((&whole 1))) (4 &body)))
-;(put 'with-condition-handler 'common-lisp-indent-function '((1 4 ((* 1))) (2 &body)))
-;(put 'condition-case 'common-lisp-indent-function '((1 4) (* 2 ((0 1) (1 3) (2 &body)))))
-;(put 'defclass 'common-lisp-indent-function '((&whole 2 &rest (&whole 2 &rest 1) &rest (&whole 2 &rest 1)))
-;(put 'defgeneric 'common-lisp-indent-function 'defun)
+;;; (common-lisp-run-indentation-tests)
 
 ;;; cl-indent.el ends here

--- /project/slime/cvsroot/slime/contrib/slime-cl-indent-test.txt	2011/06/10 14:18:40	NONE
+++ /project/slime/cvsroot/slime/contrib/slime-cl-indent-test.txt	2011/06/10 14:18:40	1.1
;;;; -*- mode: lisp -*-
;;;;
;;;; This file is .txt, because it's not meant to be evaluated.
;;;; common-lisp-run-indentation-tests in slime-cl-ident.el
;;;; parses this and runs the specified tests.

;;; Test: 1


[340 lines skipped]



From nsiivola at common-lisp.net  Fri Jun 10 15:19:31 2011
From: nsiivola at common-lisp.net (CVS User nsiivola)
Date: Fri, 10 Jun 2011 08:19:31 -0700
Subject: [slime-cvs] CVS slime/contrib
Message-ID: <E1QV3Uh-0008Ln-7R@common-lisp.net>

Update of /project/slime/cvsroot/slime/contrib
In directory common-lisp.net:/tmp/cvs-serv32098/contrib

Modified Files:
	ChangeLog slime-cl-indent-test.txt slime-cl-indent.el 
Log Message:
slime-indentation: another bug in the fallback method

  Handle (foo (
               bar quux
	       zor))

  and similar.


--- /project/slime/cvsroot/slime/contrib/ChangeLog	2011/06/10 14:18:39	1.471
+++ /project/slime/cvsroot/slime/contrib/ChangeLog	2011/06/10 15:19:31	1.472
@@ -1,5 +1,15 @@
 2011-06-10  Nikodemus Siivola  <nikodemus at random-state.net>
 
+	slime-indentation: More adjustment to the fallback method.
+
+	* slime-cl-indent.el (common-lisp-indent-function-1): handle
+	case of empty or comment line following the opening paren
+	of the containing expression.
+
+	* slime-cl-indent-test.txt: new test case.
+
+	slime-indentation: Test refactoring.
+
 	* slime-cl-indent.el (common-lisp-indent-test): replaces
 	test-lisp-indent.
 	(common-lisp-run-indentation-tests): replaces
--- /project/slime/cvsroot/slime/contrib/slime-cl-indent-test.txt	2011/06/10 14:18:39	1.1
+++ /project/slime/cvsroot/slime/contrib/slime-cl-indent-test.txt	2011/06/10 15:19:31	1.2
@@ -346,3 +346,18 @@
 
 (foo
  (bar))
+
+;;; Test: 32
+;;
+;; comment-indent-function: (lambda () nil)
+;; comment-column: nil
+
+(unknown (;; KLUDGE: comment-indent hackery to get
+          ;; the comment right. Otherwise we get a
+          ;; space before the first ;.
+          bar quux
+          zot)
+         (#|fii|#
+          zot)
+         (
+          quux))
--- /project/slime/cvsroot/slime/contrib/slime-cl-indent.el	2011/06/10 14:18:39	1.34
+++ /project/slime/cvsroot/slime/contrib/slime-cl-indent.el	2011/06/10 15:19:31	1.35
@@ -834,10 +834,14 @@
               (let ((p (point)))
                 (goto-char containing-sexp)
                 (down-list)
-                (forward-sexp 2)
-                (backward-sexp)
-                (unless (= p (point))
-                  (current-column)))))))))
+                (let ((one (current-column)))
+                  (skip-chars-forward " \t")
+                  (if (or (eolp) (looking-at ";"))
+                      one
+                    (forward-sexp 2)
+                    (backward-sexp)
+                    (unless (= p (point))
+                      (current-column)))))))))))
 
 
 (defun common-lisp-indent-call-method (function method path state indent-point
@@ -1492,7 +1496,6 @@
   (with-temp-buffer
     (lisp-mode)
     (setq indent-tabs-mode nil)
-    (common-lisp-set-style "common-lisp-indent-test")
     (dolist (bind bindings)
       (set (make-local-variable (car bind)) (cdr bind)))
     (insert test)




From nsiivola at common-lisp.net  Fri Jun 10 15:40:29 2011
From: nsiivola at common-lisp.net (CVS User nsiivola)
Date: Fri, 10 Jun 2011 08:40:29 -0700
Subject: [slime-cvs] CVS slime/contrib
Message-ID: <E1QV3oz-0000dh-Kf@common-lisp.net>

Update of /project/slime/cvsroot/slime/contrib
In directory common-lisp.net:/tmp/cvs-serv2456/contrib

Modified Files:
	ChangeLog slime-cl-indent.el 
Log Message:
slime-indentation: hack comment indentation in "basic" style

  All styles inherit from it, so everyone benefits.

  Haters gonna hate, but this fixes

   (foo (;; bar
         bar))

  getting a space inserted between ( and ;.


--- /project/slime/cvsroot/slime/contrib/ChangeLog	2011/06/10 15:19:31	1.472
+++ /project/slime/cvsroot/slime/contrib/ChangeLog	2011/06/10 15:40:29	1.473
@@ -1,5 +1,8 @@
 2011-06-10  Nikodemus Siivola  <nikodemus at random-state.net>
 
+	* slime-cl-indent.el ("basic"): Hack comment indentation
+	to avoid inserting spaces where they don't belong.
+
 	slime-indentation: More adjustment to the fallback method.
 
 	* slime-cl-indent.el (common-lisp-indent-function-1): handle
--- /project/slime/cvsroot/slime/contrib/slime-cl-indent.el	2011/06/10 15:19:31	1.35
+++ /project/slime/cvsroot/slime/contrib/slime-cl-indent.el	2011/06/10 15:40:29	1.36
@@ -349,7 +349,8 @@
 (define-common-lisp-style "basic"
   "This style merely gives all identation variables their default values,
    making it easy to create new styles that are proof against user
-   customizations."
+   customizations. It also adjusts comment indentation from default.
+   All other predefined modes inherit from basic."
   (:variables
    (lisp-indent-maximum-backtracking 3)
    (lisp-tag-indentation 1)
@@ -363,7 +364,11 @@
    (lisp-lambda-list-keyword-alignment nil)
    (lisp-lambda-list-keyword-parameter-indentation 2)
    (lisp-lambda-list-keyword-parameter-alignment nil)
-   (lisp-indent-defun-method (4 &lambda &body))))
+   (lisp-indent-defun-method (4 &lambda &body))
+   ;; Without these (;;foo would get a space inserted between
+   ;; ( and ; by indent-sexp.
+   (comment-indent-function (lambda () nil))
+   (comment-column nil)))
 
 (define-common-lisp-style "classic"
   "This style of indentation emulates the most striking features of 1995




From nsiivola at common-lisp.net  Fri Jun 10 16:13:29 2011
From: nsiivola at common-lisp.net (CVS User nsiivola)
Date: Fri, 10 Jun 2011 09:13:29 -0700
Subject: [slime-cvs] CVS slime
Message-ID: <E1QV4Kv-0001TI-1T@common-lisp.net>

Update of /project/slime/cvsroot/slime
In directory common-lisp.net:/tmp/cvs-serv5654

Modified Files:
	ChangeLog swank.lisp 
Log Message:
swank: better macro-indentation

  lisp-indent-259 didn't handle complex destructuring right: &whole
  nested in &whole wasn't working properly. Now it hopefully
  does. (But the whole indentation spec walking really deserves a
  rewrite.)

  Derived indentation:

  * Walk the entire macro lambda-list instead of just looking for
    &BODY in the toplevel.

  * Set the base indentation to 4 in macro-indentation only for the
    first level of destructuring -- use 1 later.

  now

    (defmacro foo (x (&rest args) &body body)
      ...)

  gives

    (foo (bar quux
              zot)
        (a b
         c d)
      ...)

  instead of the old

    (foo (bar quux
              zot)
       (a b
          c d)
      ...)

  While this change may turn out to be controversial, I feel that
  since FOO and (&REST FOO) are semantically equivalent as long as the
  corresponding argument is not an atom, it seems most natural to
  treat them as indentation hints instead.

  Complaints to the usual address...


--- /project/slime/cvsroot/slime/ChangeLog	2011/06/09 17:48:47	1.2197
+++ /project/slime/cvsroot/slime/ChangeLog	2011/06/10 16:13:28	1.2198
@@ -1,3 +1,9 @@
+2011-06-10  Nikodemus Siivola  <nikodemus at random-state.net>
+
+	* swank.lisp (macro-indentation): Walk the lambda-list
+	to construct a better indentation spec instead of just
+	looking for &BODY.
+
 2011-06-09  Nikodemus Siivola  <nikodemus at random-state.net>
 
 	* swank-sbcl.lisp (execv): Stupid SBCL hackers breaking backwards
--- /project/slime/cvsroot/slime/swank.lisp	2011/06/09 16:35:09	1.744
+++ /project/slime/cvsroot/slime/swank.lisp	2011/06/10 16:13:28	1.745
@@ -3944,9 +3944,20 @@
       nil))
 
 (defun macro-indentation (arglist)
-  (if (well-formed-list-p arglist)
-      (position '&body (remove '&optional (clean-arglist arglist)))
-      nil))
+  (labels ((walk (list &optional base)
+             (when (consp list)
+               (let ((head (car list))
+                     (n (if base 4 1)))
+                 (cond ((consp head)
+                        (let ((indent (walk head)))
+                          (cons (list* "&whole" n indent) (walk (cdr list) base))))
+                       ((eq '&body head)
+                        '("&body"))
+                       ((member head lambda-list-keywords)
+                        '("&rest" 1))
+                       (t
+                        (cons n (walk (cdr list) base))))))))
+    (walk arglist t)))
 
 (defun clean-arglist (arglist)
   "Remove &whole, &enviroment, and &aux elements from ARGLIST."




From nsiivola at common-lisp.net  Fri Jun 10 16:13:29 2011
From: nsiivola at common-lisp.net (CVS User nsiivola)
Date: Fri, 10 Jun 2011 09:13:29 -0700
Subject: [slime-cvs] CVS slime/contrib
Message-ID: <E1QV4Kv-0001TZ-5n@common-lisp.net>

Update of /project/slime/cvsroot/slime/contrib
In directory common-lisp.net:/tmp/cvs-serv5654/contrib

Modified Files:
	ChangeLog slime-cl-indent-test.txt slime-cl-indent.el 
Log Message:
swank: better macro-indentation

  lisp-indent-259 didn't handle complex destructuring right: &whole
  nested in &whole wasn't working properly. Now it hopefully
  does. (But the whole indentation spec walking really deserves a
  rewrite.)

  Derived indentation:

  * Walk the entire macro lambda-list instead of just looking for
    &BODY in the toplevel.

  * Set the base indentation to 4 in macro-indentation only for the
    first level of destructuring -- use 1 later.

  now

    (defmacro foo (x (&rest args) &body body)
      ...)

  gives

    (foo (bar quux
              zot)
        (a b
         c d)
      ...)

  instead of the old

    (foo (bar quux
              zot)
       (a b
          c d)
      ...)

  While this change may turn out to be controversial, I feel that
  since FOO and (&REST FOO) are semantically equivalent as long as the
  corresponding argument is not an atom, it seems most natural to
  treat them as indentation hints instead.

  Complaints to the usual address...


--- /project/slime/cvsroot/slime/contrib/ChangeLog	2011/06/10 15:40:29	1.473
+++ /project/slime/cvsroot/slime/contrib/ChangeLog	2011/06/10 16:13:29	1.474
@@ -1,5 +1,13 @@
 2011-06-10  Nikodemus Siivola  <nikodemus at random-state.net>
 
+	Better handling of complex indentation specs.
+
+	* slime-cl-indent.el (common-lisp-run-indentation-tests): Add
+	a style with complex specs for testing.
+	(lisp-indent-259): fix handling of nested &whole. Hopefully.
+
+	slime-indentation: Comment indentation in styles.
+
 	* slime-cl-indent.el ("basic"): Hack comment indentation
 	to avoid inserting spaces where they don't belong.
 
--- /project/slime/cvsroot/slime/contrib/slime-cl-indent-test.txt	2011/06/10 15:19:31	1.2
+++ /project/slime/cvsroot/slime/contrib/slime-cl-indent-test.txt	2011/06/10 16:13:29	1.3
@@ -361,3 +361,37 @@
           zot)
          (
           quux))
+
+;;; Test: 33
+
+(complex-indent.1 ((x z
+                    f
+                    ((fox foo
+                          foo))
+                    :note (ding bar quux
+                                zot)
+                    :wait (this! is
+                                 a funcall))
+                    ;; Not 100% sure this should not be a step left.
+                    (abbb)
+                    (abb))
+  (bodyform)
+  (another))
+
+;;; Test: 34
+
+(complex-indent.2 (bar quux
+                       zot)
+    (a b
+     c d)
+  (form1)
+  (form2))
+
+;;; Test: 35
+
+(complex-indent.3 (:wait fii
+                         (this is
+                               a funcall))
+  (bodyform)
+  (another))
+
--- /project/slime/cvsroot/slime/contrib/slime-cl-indent.el	2011/06/10 15:40:29	1.36
+++ /project/slime/cvsroot/slime/contrib/slime-cl-indent.el	2011/06/10 16:13:29	1.37
@@ -943,103 +943,97 @@
 (defun lisp-indent-259
     (method path state indent-point sexp-column normal-indent)
   (catch 'exit
-    (let ((p path)
-          (containing-form-start (elt state 1))
-          n tem tail)
-      ;; Isn't tail-recursion wonderful?
-      (while p
-        ;; This while loop is for destructuring.
-        ;; p is set to (cdr p) each iteration.
-        (if (not (consp method)) (lisp-indent-report-bad-format method))
-        (setq n (1- (car p))
-              p (cdr p)
-              tail nil)
-        (while n
-          ;; This while loop is for advancing along a method
-          ;; until the relevant (possibly &rest/&body) pattern
-          ;; is reached.
-          ;; n is set to (1- n) and method to (cdr method)
-          ;; each iteration.
-          (setq tem (car method))
-
-          (or (eq tem 'nil)             ;default indentation
-              (eq tem '&lambda)         ;lambda list
-              (and (eq tem '&body) (null (cdr method)))
-              (and (eq tem '&rest)
-                   (consp (cdr method))
-                   (null (cddr method)))
-              (integerp tem)            ;explicit indentation specified
-              (and (consp tem)          ;destructuring
-                   (eq (car tem) '&whole)
-                   (or (symbolp (cadr tem))
-                       (integerp (cadr tem))))
-              (and (symbolp tem)        ;a function to call to do the work.
-                   (null (cdr method)))
-              (lisp-indent-report-bad-format method))
-
-          (cond ((eq tem '&body)
-                 ;; &body means (&rest <lisp-body-indent>)
-                 (throw 'exit
-                   (if (and (= n 0)     ;first body form
-                            (null p))   ;not in subforms
-                       (+ sexp-column
-                          lisp-body-indent)
-                       normal-indent)))
-                ((eq tem '&rest)
-                 ;; this pattern holds for all remaining forms
-                 (setq tail (> n 0)
-                       n 0
-                       method (cdr method)))
-                ((> n 0)
-                 ;; try next element of pattern
-                 (setq n (1- n)
-                       method (cdr method))
-                 (if (< n 0)
-                     ;; Too few elements in pattern.
-                     (throw 'exit normal-indent)))
-                ((eq tem 'nil)
-                 (throw 'exit (if (consp normal-indent)
-                                  normal-indent
-                                (list normal-indent containing-form-start))))
-                ((eq tem '&lambda)
-                 (throw 'exit
-                   (cond ((null p)
-                          (list (+ sexp-column 4) containing-form-start))
-                         (t
-                          ;; Indentation within a lambda-list. -- dvl
-                          (list (lisp-indent-lambda-list
-                                 indent-point
-                                 sexp-column
-                                 containing-form-start)
-                                containing-form-start)))))
-                ((integerp tem)
-                 (throw 'exit
-                   (if (null p)         ;not in subforms
-                       (list (+ sexp-column tem) containing-form-start)
-                       normal-indent)))
-                ((symbolp tem)          ;a function to call
+    (let* ((p (cdr path))
+           (containing-form-start (elt state 1))
+           (n (1- (car path)))
+           tem tail)
+      (if (not (consp method))
+          (lisp-indent-report-bad-format method))
+      (while n
+        ;; This while loop is for advancing along a method
+        ;; until the relevant (possibly &rest/&body) pattern
+        ;; is reached.
+        ;; n is set to (1- n) and method to (cdr method)
+        ;; each iteration.
+        (setq tem (car method))
+
+        (or (eq tem 'nil)             ;default indentation
+            (eq tem '&lambda)         ;lambda list
+            (and (eq tem '&body) (null (cdr method)))
+            (and (eq tem '&rest)
+                 (consp (cdr method))
+                 (null (cddr method)))
+            (integerp tem)            ;explicit indentation specified
+            (and (consp tem)          ;destructuring
+                 (or (consp (car tem))
+                     (and (eq (car tem) '&whole)
+                          (or (symbolp (cadr tem))
+                              (integerp (cadr tem))))))
+            (and (symbolp tem)        ;a function to call to do the work.
+                 (null (cdr method)))
+            (lisp-indent-report-bad-format method))
+        (cond ((eq tem '&body)
+               ;; &body means (&rest <lisp-body-indent>)
+               (throw 'exit
+                      (if (null p)
+                          (+ sexp-column lisp-body-indent)
+                        normal-indent)))
+              ((eq tem '&rest)
+               ;; this pattern holds for all remaining forms
+               (setq tail (> n 0)
+                     n 0
+                     method (cdr method)))
+              ((> n 0)
+               ;; try next element of pattern
+               (setq n (1- n)
+                     method (cdr method))
+               (if (< n 0)
+                   ;; Too few elements in pattern.
+                   (throw 'exit normal-indent)))
+              ((eq tem 'nil)
+               (throw 'exit (if (consp normal-indent)
+                                normal-indent
+                              (list normal-indent containing-form-start))))
+              ((eq tem '&lambda)
+               (throw 'exit
+                      (cond ((null p)
+                             (list (+ sexp-column 4) containing-form-start))
+                            (t
+                             ;; Indentation within a lambda-list. -- dvl
+                             (list (lisp-indent-lambda-list
+                                    indent-point
+                                    sexp-column
+                                    containing-form-start)
+                                   containing-form-start)))))
+              ((integerp tem)
+               (throw 'exit
+                      (if (null p)         ;not in subforms
+                          (list (+ sexp-column tem) containing-form-start)
+                        normal-indent)))
+              ((symbolp tem)          ;a function to call
+               (throw 'exit
+                      (funcall tem path state indent-point
+                               sexp-column normal-indent)))
+              (t
+               ;; must be a destructing frob
+               (if (not (null p))
+                   ;; descend
+                   (setq method (cddr tem)
+                         n (car p)
+                         p (cdr p))
+                 (setq tem (cadr tem))
                  (throw 'exit
-                   (funcall tem path state indent-point
-                            sexp-column normal-indent)))
-                (t
-                 ;; must be a destructing frob
-                 (if (not (null p))
-                     ;; descend
-                     (setq method (cddr tem)
-                           n nil)
-                   (setq tem (cadr tem))
-                   (throw 'exit
-                     (cond (tail
-                            normal-indent)
-                           ((eq tem 'nil)
-                            (list normal-indent
-                                  containing-form-start))
-                           ((integerp tem)
-                            (list (+ sexp-column tem)
-                                  containing-form-start))
-                           (t
-                            (funcall tem path state indent-point
-                                     sexp-column normal-indent))))))))))))
+                        (cond (tail
+                               normal-indent)
+                              ((eq tem 'nil)
+                               (list normal-indent
+                                     containing-form-start))
+                              ((integerp tem)
+                               (list (+ sexp-column tem)
+                                     containing-form-start))
+                              (t
+                               (funcall tem path state indent-point
+                                        sexp-column normal-indent)))))))))))
 
 (defun lisp-indent-tagbody (path state indent-point sexp-column normal-indent)
   (if (not (null (cdr path)))
@@ -1501,6 +1495,7 @@
   (with-temp-buffer
     (lisp-mode)
     (setq indent-tabs-mode nil)
+    (common-lisp-set-style "common-lisp-indent-test")
     (dolist (bind bindings)
       (set (make-local-variable (car bind)) (cdr bind)))
     (insert test)
@@ -1533,6 +1528,14 @@
                (buffer-string))))))
 
 (defun common-lisp-run-indentation-tests ()
+  (define-common-lisp-style "common-lisp-indent-test"
+    ;; Used to specify a few complex indentation specs for testing.
+    (:inherit "basic")
+    (:indentation
+     (complex-indent.1 ((&whole 4 (&whole 1 1 1 1 (&whole 1 1) &rest 1)
+                                &body) &body))
+     (complex-indent.2 (4 (&whole 4 &rest 1) &body))
+     (complex-indent.3 (4 &body))))
   (with-temp-buffer
     (insert-file "slime-cl-indent-test.txt")
     (goto-char 0)
@@ -1568,6 +1571,7 @@
                   (common-lisp-indent-test test-name bindings test)
                   (incf n))))
           (forward-line 1)))
+      (common-lisp-delete-style "common-lisp-indent-test")
       (message "%s tests OK." n))))
 
 ;;; (common-lisp-run-indentation-tests)




From nsiivola at common-lisp.net  Fri Jun 10 17:13:04 2011
From: nsiivola at common-lisp.net (CVS User nsiivola)
Date: Fri, 10 Jun 2011 10:13:04 -0700
Subject: [slime-cvs] CVS slime/contrib
Message-ID: <E1QV5Ga-0003VC-7R@common-lisp.net>

Update of /project/slime/cvsroot/slime/contrib
In directory common-lisp.net:/tmp/cvs-serv13461/contrib

Modified Files:
	ChangeLog slime-cl-indent-test.txt slime-cl-indent.el 
Log Message:
slime-indentation: fix , and ,@ at the start of the indentation

  Use the first comma as the basis.


--- /project/slime/cvsroot/slime/contrib/ChangeLog	2011/06/10 16:13:29	1.474
+++ /project/slime/cvsroot/slime/contrib/ChangeLog	2011/06/10 17:13:04	1.475
@@ -1,5 +1,12 @@
 2011-06-10  Nikodemus Siivola  <nikodemus at random-state.net>
 
+	Take , and ,@ into account properly.
+
+	* slime-cl-indent.el (common-lisp-indent-function-1): Adjust
+	normal-indent to take , and ,@ into account
+
+	* slime-cl-indent-test.txt: Test case 36-38.
+
 	Better handling of complex indentation specs.
 
 	* slime-cl-indent.el (common-lisp-run-indentation-tests): Add
--- /project/slime/cvsroot/slime/contrib/slime-cl-indent-test.txt	2011/06/10 16:13:29	1.3
+++ /project/slime/cvsroot/slime/contrib/slime-cl-indent-test.txt	2011/06/10 17:13:04	1.4
@@ -395,3 +395,28 @@
   (bodyform)
   (another))
 
+;;; Test: 36
+
+(defmacro foo (body)
+  `(let (,@(stuff)
+         ,(more-stuff)
+         ,(even-more)
+         (foo foo))
+     , at bofy))
+
+;;; Test: 37
+
+(defun foo ()
+  `(list foo bar
+         ,@(quux fo
+                 foo)))
+
+;;; Test: 38
+
+(defmacro foofoo (body)
+  `(foo
+    `(let (,',@,(stuff)
+           ,(more-stuff)
+           ,(even-more)
+           (foo foo))
+       , at bofy)))
--- /project/slime/cvsroot/slime/contrib/slime-cl-indent.el	2011/06/10 16:13:29	1.37
+++ /project/slime/cvsroot/slime/contrib/slime-cl-indent.el	2011/06/10 17:13:04	1.38
@@ -661,6 +661,10 @@
   (common-lisp-indent-function-1 indent-point state))
 
 (defun common-lisp-indent-function-1 (indent-point state)
+  ;; If we're looking at a splice, move to the first comma.
+  (when (or (looking-back ",") (looking-back ",@"))
+    (when (re-search-backward "[^,@'],")
+      (forward-char 1))
   (let ((normal-indent (current-column)))
     ;; Walk up list levels until we see something
     ;;  which does special things with subforms.




From nsiivola at common-lisp.net  Fri Jun 10 19:02:09 2011
From: nsiivola at common-lisp.net (CVS User nsiivola)
Date: Fri, 10 Jun 2011 12:02:09 -0700
Subject: [slime-cvs] CVS slime/contrib
Message-ID: <E1QV6y9-0006xy-Mb@common-lisp.net>

Update of /project/slime/cvsroot/slime/contrib
In directory common-lisp.net:/tmp/cvs-serv26777/contrib

Modified Files:
	ChangeLog slime-cl-indent.el 
Log Message:
slime-indentation: missing paren

--- /project/slime/cvsroot/slime/contrib/ChangeLog	2011/06/10 17:13:04	1.475
+++ /project/slime/cvsroot/slime/contrib/ChangeLog	2011/06/10 19:02:09	1.476
@@ -1,5 +1,8 @@
 2011-06-10  Nikodemus Siivola  <nikodemus at random-state.net>
 
+	* slime-cl-indent.el (common-lisp-indent-function-1): Missing
+	paren. Teaches me to to paredit.
+
 	Take , and ,@ into account properly.
 
 	* slime-cl-indent.el (common-lisp-indent-function-1): Adjust
--- /project/slime/cvsroot/slime/contrib/slime-cl-indent.el	2011/06/10 17:13:04	1.38
+++ /project/slime/cvsroot/slime/contrib/slime-cl-indent.el	2011/06/10 19:02:09	1.39
@@ -664,7 +664,7 @@
   ;; If we're looking at a splice, move to the first comma.
   (when (or (looking-back ",") (looking-back ",@"))
     (when (re-search-backward "[^,@'],")
-      (forward-char 1))
+      (forward-char 1)))
   (let ((normal-indent (current-column)))
     ;; Walk up list levels until we see something
     ;;  which does special things with subforms.




From nsiivola at common-lisp.net  Fri Jun 10 20:03:33 2011
From: nsiivola at common-lisp.net (CVS User nsiivola)
Date: Fri, 10 Jun 2011 13:03:33 -0700
Subject: [slime-cvs] CVS slime/contrib
Message-ID: <E1QV7vZ-0008VD-SU@common-lisp.net>

Update of /project/slime/cvsroot/slime/contrib
In directory common-lisp.net:/tmp/cvs-serv32683/contrib

Modified Files:
	ChangeLog slime-cl-indent-test.txt slime-cl-indent.el 
Log Message:
slime-indentation: indent boa-constructor lambda-lists properly

--- /project/slime/cvsroot/slime/contrib/ChangeLog	2011/06/10 19:02:09	1.476
+++ /project/slime/cvsroot/slime/contrib/ChangeLog	2011/06/10 20:03:33	1.477
@@ -1,5 +1,12 @@
 2011-06-10  Nikodemus Siivola  <nikodemus at random-state.net>
 
+	Boa-constructor indentation.
+
+	* slime-cl-indent.el: Give :constructor the appropriate
+	indentation method.
+
+	* slime-cl-indent-test.txt: Test-case 39.
+
 	* slime-cl-indent.el (common-lisp-indent-function-1): Missing
 	paren. Teaches me to to paredit.
 
--- /project/slime/cvsroot/slime/contrib/slime-cl-indent-test.txt	2011/06/10 17:13:04	1.4
+++ /project/slime/cvsroot/slime/contrib/slime-cl-indent-test.txt	2011/06/10 20:03:33	1.5
@@ -420,3 +420,18 @@
            ,(even-more)
            (foo foo))
        , at bofy)))
+
+;;; Test: 39
+;;
+;; lisp-lambda-list-keyword-parameter-alignment: t
+;; lisp-lambda-list-keyword-alignment: t
+
+(defstruct (foo (:constructor make-foo (&optional bar
+                                                  quux
+                                        &key zot
+                                             fii)))
+  bar
+  quux
+  zot
+  fii)
+
--- /project/slime/cvsroot/slime/contrib/slime-cl-indent.el	2011/06/10 19:02:09	1.39
+++ /project/slime/cvsroot/slime/contrib/slime-cl-indent.el	2011/06/10 20:03:33	1.40
@@ -1409,6 +1409,8 @@
            (ctypecase   (as case))
            (catch 1)
            (cond        (&rest (&whole 2 &rest 1)))
+           ;; for DEFSTRUCT
+           (:constructor (4 &lambda))
            (defvar      (4 2 2))
            (defclass    (6 4 (&whole 2 &rest 1) (&whole 2 &rest 1)))
            (defconstant (as defvar))




From nsiivola at common-lisp.net  Sat Jun 11 14:34:59 2011
From: nsiivola at common-lisp.net (CVS User nsiivola)
Date: Sat, 11 Jun 2011 07:34:59 -0700
Subject: [slime-cvs] CVS slime/contrib
Message-ID: <E1QVPH9-0002ev-8N@common-lisp.net>

Update of /project/slime/cvsroot/slime/contrib
In directory common-lisp.net:/tmp/cvs-serv10212/contrib

Modified Files:
	ChangeLog slime-cl-indent.el 
Log Message:
slime-indentation: refactor named styles

 Now changes from a redefined style take immediate effect, including
 inheritance. (Previously you had to redefine the style you wanted to see the
 changes in as well, and then use common-lisp-set-style to activate it again.)

 Additionally, calling `common-lisp-set-style' is no longer necessary: just
 setting the buffer-local variable will cause the style to activate as long as
 common-lisp-indent-function is being used. (It remains a /good idea/ to
 call it, though, and that's what we do in the lisp-mode hook.)

 How this works:

  * common-lisp-styles now stores the specifications only: inheritance
    is marked there, but its effects are not precomputed.

  * common-lisp-active-style holds a cons:

     (<style> . <methods>)

    where <style> is the specification for the currently active style,
    and <method> is a hash-table of indentation method for it -- including
    inherited methods.

 * common-lisp-get-indentation calls common-lisp-active-style-methods,
   which does:

     (eq (car common-lisp-active-style)
         (gethash common-lisp-style common-lisp-styles))

   If this is true, it just returns the table in the cdr. Otherwise it calls
   common-lisp-activate-style to compute the methods, which also binds any
   local variables, runs initialization hooks, etc.

 * defining or redefining a style copies of style specifications currently
   in common-lisp-styles, so next time common-lisp-get-style is called,
   methods are computed anew, etc.


--- /project/slime/cvsroot/slime/contrib/ChangeLog	2011/06/10 20:03:33	1.477
+++ /project/slime/cvsroot/slime/contrib/ChangeLog	2011/06/11 14:34:59	1.478
@@ -1,3 +1,23 @@
+2011-06-11  Nikodemus Siivola  <nikodemus at random-state.net>
+
+	Refactoring named styles.
+
+	* slime-cl-indent.el (define-common-lisp-style): Not a list of hooks anymore,
+	but just a single hook. Document the fact that code in :eval option may get
+	called multiple times over the lifetime of a buffer.
+	(common-lisp-style-name, common-lisp-style-inherits)
+	(common-lisp-style-variables, common-lisp-style-indentation)
+	(common-lisp-style-hook, common-lisp-style-docstring)
+	(common-lisp-make-style, common-lisp-find-style): New functions.
+	Convenience accessors, locator, and constructor.
+	(common-lisp-add-style): Don't precompute inheritance.
+	(common-lisp-safe-style-p): For use with safe-local-variable.
+	(common-lisp-activate-style): Now handles inheritance.
+	(common-lisp-active-style-methods): New function, computes and caches
+	inheritance.
+	(common-lisp-set-style): Changes to match others.
+	(common-lisp-get-indentation): Use common-lisp-active-style-methods.
+
 2011-06-10  Nikodemus Siivola  <nikodemus at random-state.net>
 
 	Boa-constructor indentation.
--- /project/slime/cvsroot/slime/contrib/slime-cl-indent.el	2011/06/10 20:03:33	1.40
+++ /project/slime/cvsroot/slime/contrib/slime-cl-indent.el	2011/06/11 14:34:59	1.41
@@ -1,4 +1,4 @@
-;;; cl-indent.el --- enhanced lisp-indent mode
+ ;;; cl-indent.el --- enhanced lisp-indent mode
 
 ;; Copyright (C) 1987, 2000-2011 Free Software Foundation, Inc.
 
@@ -176,26 +176,40 @@
 ;;;;
 ;;;; A Common Lisp style is a list of the form:
 ;;;;
-;;;;  (NAME VARIABLES TABLE HOOKS DOCSTRING)
+;;;;  (NAME INHERIT VARIABLES INDENTATION HOOK DOCSTRING)
 ;;;;
-;;;; where NAME is a symbol naming the style, VARIABLES is an alist specifying
-;;;; buffer local variables for the style, and TABLE is a hashtable specifying
-;;;; non-standard indentations for Common Lisp symbols. HOOKS is a list of
-;;;; functions to call when activating the style. DOCSTRING is the
-;;;; documentation for the style.
+;;;; where NAME is a symbol naming the style, INHERIT is the name of the style
+;;;; it inherits from, VARIABLES is an alist specifying buffer local variables
+;;;; for the style, and INDENTATION is an alist specifying non-standard
+;;;; indentations for Common Lisp symbols. HOOK is a function to call when
+;;;; activating the style. DOCSTRING is the documentation for the style.
+;;;;
+;;;; Convenience accessors `common-lisp-style-name', &co exist.
 ;;;;
 ;;;; `common-lisp-style' stores the name of the current style.
 ;;;;
-;;;; `common-lisp-default-style' stores the name of the style to use when none
+;;;; `common-lisp-style-default' stores the name of the style to use when none
 ;;;; has been specified.
 ;;;;
-;;;; `common-lisp-active-style' stores the list specifying the current style.
-;;;; Whenever we're indenting, we check that they match -- and update the
-;;;; latter to match the former if necessary.
-;;;;
-;;;; Hence just setting the buffer local common-lisp-style will be enough
-;;;; to have the style take effect. `common-lisp-set-style' can also be called
-;;;; explicitly, however.
+;;;; `common-lisp-active-style' stores a cons of the list specifying the
+;;;; current style, and a hash-table containing all indentation methods of
+;;;; that style and any styles it inherits from. Whenever we're indenting, we
+;;;; check that this is up to date, and recompute when necessary.
+;;;;
+;;;; Just setting the buffer local common-lisp-style will be enough to have
+;;;; the style take effect. `common-lisp-set-style' can also be called
+;;;; explicitly, however, and offers name completion, etc.
+
+;;; Convenience accessors
+(defun common-lisp-style-name (style) (first style))
+(defun common-lisp-style-inherits (style) (second style))
+(defun common-lisp-style-variables (style) (third style))
+(defun common-lisp-style-indentation (style) (fourth style))
+(defun common-lisp-style-hook (style) (fifth style))
+(defun common-lisp-style-docstring (style) (sixth style))
+
+(defun common-lisp-make-style (stylename inherits variables indentation hook documentation)
+  (list stylename inherits variables indentation hook documentation))
 
 (defvar common-lisp-style nil)
 
@@ -217,20 +231,22 @@
   :type 'string
   :group 'lisp-indent)
 
-;;; Common Lisp indentation style specification for the current buffer.
-(defvar common-lisp-active-style nil)
+(make-variable-buffer-local 'common-lisp-style)
+(set-default 'common-lisp-style nil)
 
 ;;; `lisp-mode' kills all buffer-local variables. Setting the
 ;;; `permanent-local' property allows us to retain the style.
 (put 'common-lisp-style 'permanent-local t)
 
+;;; Mark as safe when the style doesn't evaluate arbitrary code.
+(put 'common-lisp-style 'safe-local-variable 'common-lisp-safe-style-p)
+
 ;;; If style is being used, that's a sufficient invitation to snag
 ;;; the indentation function.
 (defun common-lisp-lisp-mode-hook ()
   (let ((style (or common-lisp-style common-lisp-style-default)))
     (when style
-      (set (make-local-variable 'lisp-indent-function)
-           'common-lisp-indent-function)
+      (set (make-local-variable 'lisp-indent-function) 'common-lisp-indent-function)
       (common-lisp-set-style style))))
 (add-hook 'lisp-mode-hook 'common-lisp-lisp-mode-hook)
 
@@ -240,70 +256,119 @@
 (defun common-lisp-delete-style (stylename)
   (remhash stylename common-lisp-styles))
 
-(defun common-lisp-add-style (stylename base variables indentation hooks documentation)
-  (let* ((style (or (gethash stylename common-lisp-styles)
-                    (let ((new (list (intern stylename)             ; name
-                                     nil                            ; variable bindings
-                                     (make-hash-table :test 'equal) ; indentation table
-                                     nil                            ; hooks
-                                     nil)))                         ; docstring
-                      (puthash stylename new common-lisp-styles)
-                      new)))
-         (base-style (when base
-                       (or (gethash base common-lisp-styles)
-                           (error "Unknown base Common Lisp style: %s" base))))
-         (base-vars (second base-style))
-         (base-methods (third base-style))
-         (base-hooks (fourth base-style)))
-    ;; Variables
-    (setf (second style) variables)
-    (dolist (var base-vars)
-      (unless (assoc (car var) variables)
-        (push var (second style))))
-    ;; Indentation
-    (let ((methods (third style)))
-      (clrhash methods)
-      (when base-methods
-        (maphash (lambda (s m)
-                   (puthash s m methods))
-                 base-methods))
-      (dolist (indent indentation)
-        (let* ((name (car indent))
-               (spec (cdr indent))
-               (method
-                (if (symbolp spec)
-                    (list :as spec)
-                  (when (cdr spec)
-                    (error "Malformed Common Lisp indentation spec: %s" indent))
-                  (car spec))))
-          (puthash name method methods))))
-    ;; Hooks
-    (setf (fourth style) nil)
-    (dolist (hook (reverse base-hooks))
-      (unless (member hook hooks)
-        (push hook (fourth style))))
-    (dolist (hook (reverse hooks))
-      (push hook (fourth style)))
-    ;; Documentation
-    (setf (fifth style) documentation)
-    ;; Frob `common-lisp-style' docstring.
-    (let ((doc (get 'common-lisp-style 'common-lisp-style-base-doc))
-          (all nil))
-      (setq doc (concat doc "\n\nAvailable styles are:\n"))
-      (maphash (lambda (name style)
-                 (push (list name (fifth style)) all))
-               common-lisp-styles)
-      (dolist (info (sort all (lambda (a b) (string< (car a) (car b)))))
-        (let ((style-name (first info))
-              (style-doc (second info)))
-          (if style-doc
-              (setq doc (concat doc
-                                "\n " style-name "\n"
-                                "   " style-doc "\n"))
-                     (setq doc (concat doc
-                                       "\n " style-name " (undocumented)\n")))))
-      (put 'common-lisp-style 'variable-documentation doc))
-    stylename))
+(defun common-lisp-find-style (stylename)
+  (let ((name (if (symbolp stylename)
+                  (symbol-name stylename)
+                stylename)))
+    (or (gethash name common-lisp-styles)
+        (error "Unknown Common Lisp style: %s" name))))
+
+(defun common-lisp-safe-style-p (stylename)
+  "True for known Common Lisp style which doesn't have or inherit an :EVAL option.
+Ie. styles that will not evaluate arbitrary code on activation."
+  (let* ((style (ignore-errors (common-lisp-find-style stylename)))
+         (base (common-lisp-style-inherits style)))
+    (and style
+         (not (common-lisp-style-hook style))
+         (or (not base)
+             (common-lisp-safe-style-p base)))))
+
+(defun common-lisp-add-style (stylename inherits variables indentation hooks documentation)
+  ;; Invalidate indentation methods cached in common-lisp-active-style.
+  (maphash (lambda (k v)
+             (puthash k (copy-list v) common-lisp-styles))
+           common-lisp-styles)
+  ;; Add/Redefine the specified style.
+  (puthash stylename
+           (common-lisp-make-style stylename inherits variables indentation hooks
+                                   documentation)
+           common-lisp-styles)
+  ;; Frob `common-lisp-style' docstring.
+  (let ((doc (get 'common-lisp-style 'common-lisp-style-base-doc))
+        (all nil))
+    (setq doc (concat doc "\n\nAvailable styles are:\n"))
+    (maphash (lambda (name style)
+               (push (list name (common-lisp-style-docstring style)) all))
+             common-lisp-styles)
+    (dolist (info (sort all (lambda (a b) (string< (car a) (car b)))))
+      (let ((style-name (first info))
+            (style-doc (second info)))
+        (if style-doc
+            (setq doc (concat doc
+                              "\n " style-name "\n"
+                              "   " style-doc "\n"))
+          (setq doc (concat doc
+                            "\n " style-name " (undocumented)\n")))))
+    (put 'common-lisp-style 'variable-documentation doc))
+  stylename)
+
+;;; Activate STYLENAME, adding its indentation methods to METHODS -- and
+;;; recurse on style inherited from.
+(defun common-lisp-activate-style (stylename methods)
+  (let* ((style (common-lisp-find-style stylename))
+         (basename (common-lisp-style-inherits style)))
+    ;; Recurse on parent.
+    (when basename
+      (common-lisp-activate-style basename methods))
+    ;; Copy methods
+    (dolist (spec (common-lisp-style-indentation style))
+      (puthash (first spec) (second spec) methods))
+    ;; Bind variables.
+    (dolist (var (common-lisp-style-variables style))
+      (set (make-local-variable (first var)) (second var)))
+    ;; Run hook.
+    (let ((hook (common-lisp-style-hook style)))
+      (when hook
+        (funcall hook)))))
+
+;;; When a style is being used, `common-lisp-active-style' holds a cons
+;;;
+;;;   (STYLE . METHODS)
+;;;
+;;; where STYLE is the list specifying the currently active style, and
+;;; METHODS is the table of indentation methods --  including inherited
+;;; ones -- for it. `common-lisp-active-style-methods' is reponsible
+;;; for keeping this up to date.
+(make-variable-buffer-local 'common-lisp-active-style)
+(set-default 'common-lisp-active-style nil)
+
+;;; Makes sure common-lisp-active-style corresponds to common-lisp-style, and
+;;; pick up redefinitions, etc. Returns the method table for the currently
+;;; active style.
+(defun common-lisp-active-style-methods ()
+  (let* ((name common-lisp-style)
+         (style (when name (common-lisp-find-style name))))
+    (if (eq style (car common-lisp-active-style))
+        (cdr common-lisp-active-style)
+      (when style
+        (let ((methods (make-hash-table :test 'equal)))
+          (common-lisp-activate-style name methods)
+          (setq common-lisp-active-style (cons style methods))
+          methods)))))
+
+(defvar common-lisp-set-style-history nil)
+
+(defun common-lisp-set-style (stylename)
+  "Set current buffer to use the Common Lisp style STYLENAME.
+STYLENAME, a string, must be an existing Common Lisp style. Styles
+are added (and updated) using `define-common-lisp-style'.
+
+The buffer-local variable `common-lisp-style' will get set to STYLENAME.
+
+A Common Lisp style is composed of local variables, indentation
+specifications, and may also contain arbitrary elisp code to run upon
+activation."
+  (interactive
+   (list (let ((completion-ignore-case t)
+               (prompt "Specify Common Lisp indentation style: "))
+           (completing-read prompt
+                            common-lisp-styles nil t nil
+                            'common-lisp-set-style-history))))
+  (setq common-lisp-style (common-lisp-style-name (common-lisp-find-style stylename))
+        common-lisp-active-style nil)
+  ;; Actually activates the style.
+  (common-lisp-active-style-methods)
+  stylename)
 
 (defmacro define-common-lisp-style (name documentation &rest options)
   "Define a Common Lisp indentation style.
@@ -331,7 +396,9 @@
  (:eval form ...)
 
   Lisp code to evaluate when activating the style. This can be used to
-  eg. activate other modes.
+  eg. activate other modes. It is possible that over the lifetime of
+  a buffer same style gets activated multiple times, so code in :eval
+  option should cope with that.
 "
   (when (consp documentation)
     (setq documentation nil
@@ -341,9 +408,8 @@
                           ',(cdr (assoc :variables options))
                           ',(cdr (assoc :indentation options))
                           ,(when (assoc :eval options)
-                            `(list
-                              (lambda ()
-                                ,@(cdr (assoc :eval options)))))
+                             `(lambda ()
+                                ,@(cdr (assoc :eval options))))
                           ,documentation))
 
 (define-common-lisp-style "basic"
@@ -414,41 +480,6 @@
    (def!struct         (:as defstruct))
    (def!type           (:as deftype))
    (defmacro-mundanely (:as defmacro))))
-
-(defvar common-lisp-set-style-history nil)
-
-(defun common-lisp-set-style (stylename)
-  "Set current buffer to use the Common Lisp style STYLENAME.
-STYLENAME, a string, must be an existing Common Lisp style. Styles
-are added (and updated) using `common-lisp-add-style'.
-
-The buffer-local variable `common-lisp-style' will get set to STYLENAME.
-Simply setting
-
-A Common Lisp style is composed of variable and indentation specifications."
-  (interactive
-   (list (let ((completion-ignore-case t)
-               (prompt "Specify Common Lisp indentation style: "))
-           (completing-read prompt
-                            common-lisp-styles nil t nil
-                            'common-lisp-set-style-history))))
-  (let* ((stylename (if (stringp stylename)
-                        stylename
-                      (symbol-name stylename)))
-         (style (or (gethash stylename common-lisp-styles)
-                    (error "Unknown Common Lisp style: %s" stylename))))
-    (common-lisp-activate-style style)))
-
-(defun common-lisp-activate-style (style)
-  (let ((vars (second style))
-        (methods (third style))
-        (hooks (fourth style)))
-    (dolist (var vars)
-      (set (make-local-variable (car var)) (cadr var)))
-    (dolist (hook hooks)
-      (funcall hook))
-    (set (make-local-variable 'common-lisp-style) (car style))
-    (set (make-local-variable 'common-lisp-active-style) style)))
 
 ;;;; The indentation specs are stored at three levels. In order of priority:
 ;;;;
@@ -504,8 +535,8 @@
   (let ((method
          (or
           ;; From style
-          (when common-lisp-active-style
-            (gethash name (third common-lisp-active-style)))
+          (when common-lisp-style
+            (gethash name (common-lisp-active-style-methods)))
           ;; From global settings.
           (get name 'common-lisp-indent-function)
           ;; From system derived information.




From nsiivola at common-lisp.net  Sat Jun 11 14:35:16 2011
From: nsiivola at common-lisp.net (CVS User nsiivola)
Date: Sat, 11 Jun 2011 07:35:16 -0700
Subject: [slime-cvs] CVS slime/contrib
Message-ID: <E1QVPHQ-0002fq-0g@common-lisp.net>

Update of /project/slime/cvsroot/slime/contrib
In directory common-lisp.net:/tmp/cvs-serv10273/contrib

Modified Files:
	ChangeLog slime-cl-indent.el 
Log Message:
slime-indentation: XEmacs compatibility

 Kudos for Raymond Toy for being the intrepid tester.


--- /project/slime/cvsroot/slime/contrib/ChangeLog	2011/06/11 14:34:59	1.478
+++ /project/slime/cvsroot/slime/contrib/ChangeLog	2011/06/11 14:35:15	1.479
@@ -1,5 +1,15 @@
 2011-06-11  Nikodemus Siivola  <nikodemus at random-state.net>
 
+	XEmacs compatibility.
+
+	* slime-cl-indent.el (common-lisp-style-names): New function.
+	(common-lisp-set-style): Call common-lisp-style-names instead of
+	using the hashtable directly: XEmacs doesn't like hash-tables in
+	completing-read.
+	(common-lisp-looking-back): New function.
+	(common-lisp-indent-function-1): Use common-lisp-looking-back instead
+	of looking-back: XEmacs doesn't have looking-back.
+
 	Refactoring named styles.
 
 	* slime-cl-indent.el (define-common-lisp-style): Not a list of hooks anymore,
--- /project/slime/cvsroot/slime/contrib/slime-cl-indent.el	2011/06/11 14:34:59	1.41
+++ /project/slime/cvsroot/slime/contrib/slime-cl-indent.el	2011/06/11 14:35:15	1.42
@@ -348,6 +348,13 @@
 
 (defvar common-lisp-set-style-history nil)
 
+(defun common-lisp-style-names ()
+  (let (names)
+    (maphash (lambda (k v)
+               (push k names))
+             common-lisp-styles)
+    names))
+
 (defun common-lisp-set-style (stylename)
   "Set current buffer to use the Common Lisp style STYLENAME.
 STYLENAME, a string, must be an existing Common Lisp style. Styles
@@ -362,7 +369,7 @@
    (list (let ((completion-ignore-case t)
                (prompt "Specify Common Lisp indentation style: "))
            (completing-read prompt
-                            common-lisp-styles nil t nil
+                            (common-lisp-style-names) nil t nil
                             'common-lisp-set-style-history))))
   (setq common-lisp-style (common-lisp-style-name (common-lisp-find-style stylename))
         common-lisp-active-style nil)
@@ -691,9 +698,17 @@
     have an offset of 2+1=3."
   (common-lisp-indent-function-1 indent-point state))
 
+;;; XEmacs doesn't have looking-back, so we define a simple one. Faster to
+;;; boot, and sufficient for our needs.
+(defun common-lisp-looking-back (string)
+  (let ((len (length string)))
+    (dotimes (i len t)
+      (unless (eql (elt string (- len i 1)) (char-before (- (point) i)))
+        (return nil)))))
+
 (defun common-lisp-indent-function-1 (indent-point state)
   ;; If we're looking at a splice, move to the first comma.
-  (when (or (looking-back ",") (looking-back ",@"))
+  (when (or (common-lisp-looking-back ",") (common-lisp-looking-back ",@"))
     (when (re-search-backward "[^,@'],")
       (forward-char 1)))
   (let ((normal-indent (current-column)))




From nsiivola at common-lisp.net  Sat Jun 11 19:24:36 2011
From: nsiivola at common-lisp.net (CVS User nsiivola)
Date: Sat, 11 Jun 2011 12:24:36 -0700
Subject: [slime-cvs] CVS slime/contrib
Message-ID: <E1QVTnQ-00055X-DA@common-lisp.net>

Update of /project/slime/cvsroot/slime/contrib
In directory common-lisp.net:/tmp/cvs-serv19558/contrib

Modified Files:
	ChangeLog slime-cl-indent.el 
Log Message:
slime-indentation: more XEmacs compatibility

  Hopefully this is all...


--- /project/slime/cvsroot/slime/contrib/ChangeLog	2011/06/11 14:35:15	1.479
+++ /project/slime/cvsroot/slime/contrib/ChangeLog	2011/06/11 19:24:36	1.480
@@ -1,5 +1,8 @@
 2011-06-11  Nikodemus Siivola  <nikodemus at random-state.net>
 
+	* slime-cl-indent.el (common-lisp-style-names): XEmacs doesn't
+	like lists either in completing-read -- need an alist.
+
 	XEmacs compatibility.
 
 	* slime-cl-indent.el (common-lisp-style-names): New function.
--- /project/slime/cvsroot/slime/contrib/slime-cl-indent.el	2011/06/11 14:35:15	1.42
+++ /project/slime/cvsroot/slime/contrib/slime-cl-indent.el	2011/06/11 19:24:36	1.43
@@ -351,7 +351,7 @@
 (defun common-lisp-style-names ()
   (let (names)
     (maphash (lambda (k v)
-               (push k names))
+               (push (cons k v) names))
              common-lisp-styles)
     names))
 




From nsiivola at common-lisp.net  Tue Jun 14 09:33:39 2011
From: nsiivola at common-lisp.net (CVS User nsiivola)
Date: Tue, 14 Jun 2011 02:33:39 -0700
Subject: [slime-cvs] CVS slime/contrib
Message-ID: <E1QWQ0B-0003UE-Au@common-lisp.net>

Update of /project/slime/cvsroot/slime/contrib
In directory common-lisp.net:/tmp/cvs-serv13396/contrib

Modified Files:
	ChangeLog slime-cl-indent-test.txt slime-cl-indent.el 
Log Message:
slime-indentation: even better defmethod indentation

  Fix indentation of non-toplevel defmethods, and Handle qualifiers in
  defgeneric :methods as well.


--- /project/slime/cvsroot/slime/contrib/ChangeLog	2011/06/11 19:24:36	1.480
+++ /project/slime/cvsroot/slime/contrib/ChangeLog	2011/06/14 09:33:39	1.481
@@ -1,3 +1,11 @@
+2011-06-14  Nikodemus Siivola  <nikodemus at random-state.net>
+
+	* slime-cl-indent.el (lisp-beginning-of-defmethod): New function.
+	(lisp-indent-defmethod): Extend to work with non-toplevel defmethods,
+	and method definitions inside defgenerics.
+
+	* slime-cl-indent-test.txt: Tests 40-43.
+
 2011-06-11  Nikodemus Siivola  <nikodemus at random-state.net>
 
 	* slime-cl-indent.el (common-lisp-style-names): XEmacs doesn't
--- /project/slime/cvsroot/slime/contrib/slime-cl-indent-test.txt	2011/06/10 20:03:33	1.5
+++ /project/slime/cvsroot/slime/contrib/slime-cl-indent-test.txt	2011/06/14 09:33:39	1.6
@@ -435,3 +435,43 @@
   zot
   fii)
 
+;;; Test: 40
+;;
+;; lisp-lambda-list-keyword-parameter-alignment: t
+;; lisp-lambda-list-keyword-alignment: t
+
+(defmethod foo :around (zot &key x
+                                 y)
+  (list zot))
+
+;;; Test: 41
+;;
+;; lisp-lambda-list-keyword-parameter-alignment: t
+;; lisp-lambda-list-keyword-alignment: t
+
+(progn
+  (defmethod foo :around (fii &key x
+                                   y)
+    (list fii)))
+
+;;; Test: 42
+;;
+;; lisp-lambda-list-keyword-parameter-alignment: t
+;; lisp-lambda-list-keyword-alignment: t
+
+(progn
+  (defgeneric foo (x y &optional a
+                                 b)
+    (:method :around (a b &optional x
+                                    y)
+      (list a b x y))))
+
+;;; Test: 43
+;;
+;; lisp-lambda-list-keyword-parameter-alignment: t
+;; lisp-lambda-list-keyword-alignment: t
+
+(defgeneric foo (x &optional a b)
+  (:method (x y &optional a
+                          b)
+    (list x y a b)))
--- /project/slime/cvsroot/slime/contrib/slime-cl-indent.el	2011/06/11 19:24:36	1.43
+++ /project/slime/cvsroot/slime/contrib/slime-cl-indent.el	2011/06/14 09:33:39	1.44
@@ -1153,28 +1153,33 @@
           (t 2)))))
    (elt state 1)))
 
+(defun lisp-beginning-of-defmethod ()
+  (let ((regexp "(defmethod\\|(DEFMETHOD\\|(:method\\|(:METHOD")
+        (ok nil))
+    (while (and (not (setq ok (looking-at regexp)))
+                (ignore-errors (backward-up-list) t)))
+    ok))
+
 ;; LISP-INDENT-DEFMETHOD now supports the presence of more than one method
 ;; qualifier and indents the method's lambda list properly. -- dvl
 (defun lisp-indent-defmethod
     (path state indent-point sexp-column normal-indent)
   (lisp-indent-259
-   (let ((nqual 0))
-     (if (and (>= (car path) 3)
-              (save-excursion
-                (beginning-of-defun)
-                (forward-char 1)
-                (forward-sexp 2)
-                (skip-chars-forward " \t\n")
-                (while (looking-at "\\sw\\|\\s_")
-                  (incf nqual)
-                  (forward-sexp)
-                  (skip-chars-forward " \t\n"))
-                (> nqual 0)))
-         (append '(4) (make-list nqual 4) '(&lambda &body))
+   (let ((nskip 0))
+     (if (save-excursion
+           (when (lisp-beginning-of-defmethod)
+             (forward-char)
+             (forward-sexp 1)
+             (skip-chars-forward " \t\n")
+             (while (looking-at "\\sw\\|\\s_")
+               (incf nskip)
+               (forward-sexp)
+               (skip-chars-forward " \t\n"))
+             t))
+         (append (make-list nskip 4) '(&lambda &body))
        (common-lisp-get-indentation 'defun)))
    path state indent-point sexp-column normal-indent))
 
-
 (defun lisp-indent-function-lambda-hack (path state indent-point
                                          sexp-column normal-indent)
   ;; indent (function (lambda () <newline> <body-forms>)) kludgily.
@@ -1501,7 +1506,7 @@
            (restart-bind (as let))
            (locally 1)
            (loop           lisp-indent-loop)
-           (:method (&lambda &body)) ; in `defgeneric'
+           (:method        lisp-indent-defmethod) ; in `defgeneric'
            (multiple-value-bind ((&whole 6 &rest 1) 4 &body))
            (multiple-value-call (4 &body))
            (multiple-value-prog1 1)




From nsiivola at common-lisp.net  Tue Jun 14 10:26:28 2011
From: nsiivola at common-lisp.net (CVS User nsiivola)
Date: Tue, 14 Jun 2011 03:26:28 -0700
Subject: [slime-cvs] CVS slime/contrib
Message-ID: <E1QWQpI-0005Cl-5Z@common-lisp.net>

Update of /project/slime/cvsroot/slime/contrib
In directory common-lisp.net:/tmp/cvs-serv20006/contrib

Modified Files:
	ChangeLog slime-cl-indent-test.txt slime-cl-indent.el 
Log Message:
slime-indentation: don't consider DEFINER and DEFINITION to be defun-like

  They're normally not.


--- /project/slime/cvsroot/slime/contrib/ChangeLog	2011/06/14 09:33:39	1.481
+++ /project/slime/cvsroot/slime/contrib/ChangeLog	2011/06/14 10:26:28	1.482
@@ -1,5 +1,14 @@
 2011-06-14  Nikodemus Siivola  <nikodemus at random-state.net>
 
+	Don't consider DEFINER and DEFINITION as tentative defuns.
+
+	* slime-cl-indent.el (common-lisp-indent-function-1): Don't consider
+	"definition" or "definer" to be tentative defuns.
+
+	* slime-cl-indent-test.txt: Tests 44-45.
+
+	Better DEFMETHOD and :METHOD indentation.
+
 	* slime-cl-indent.el (lisp-beginning-of-defmethod): New function.
 	(lisp-indent-defmethod): Extend to work with non-toplevel defmethods,
 	and method definitions inside defgenerics.
--- /project/slime/cvsroot/slime/contrib/slime-cl-indent-test.txt	2011/06/14 09:33:39	1.6
+++ /project/slime/cvsroot/slime/contrib/slime-cl-indent-test.txt	2011/06/14 10:26:28	1.7
@@ -475,3 +475,19 @@
   (:method (x y &optional a
                           b)
     (list x y a b)))
+
+;;; Test: 44
+
+(let (definer
+      foo
+      bar
+      quux)
+  ...)
+
+;;; Test: 45
+
+(let (definition
+      foo
+      bar
+      quux)
+  ...)
--- /project/slime/cvsroot/slime/contrib/slime-cl-indent.el	2011/06/14 09:33:39	1.44
+++ /project/slime/cvsroot/slime/contrib/slime-cl-indent.el	2011/06/14 10:26:28	1.45
@@ -776,24 +776,21 @@
                            (error nil))))
               (setq path (cons n path)))
 
-            ;; backwards compatibility.
-            (cond ((null function))
-                  ((null method)
-                   (when (null (cdr path))
-                     ;; (package prefix was stripped off above)
-                     (cond ((and (string-match "\\`def" function)
-                                 (not (string-match "\\`default" function)))
-                            (setq tentative-defun t))
-                           ((string-match
-                             (eval-when-compile
-                              (concat "\\`\\("
-                                      (regexp-opt '("with" "without" "do"))
-                                      "\\)-"))
-                             function)
-                            (setq method '(&lambda &body))))))
-                  ;; backwards compatibility.  Bletch.
-                  ((eq method 'defun)
-                   (setq method lisp-indent-defun-method)))
+            ;; Guess.
+            (when (and (not method) function (null (cdr path)))
+              ;; (package prefix was stripped off above)
+              (cond ((and (string-match "\\`def" function)
+                          (not (string-match "\\`default" function))
+                          (not (string-match "\\`definition" function))
+                          (not (string-match "\\`definer" function)))
+                     (setq tentative-defun t))
+                    ((string-match
+                      (eval-when-compile
+                        (concat "\\`\\("
+                                (regexp-opt '("with" "without" "do"))
+                                "\\)-"))
+                      function)
+                     (setq method '(&lambda &body)))))
 
             (cond ((and (or (eq (char-after (1- containing-sexp)) ?\')
                             (and (not lisp-backquote-indentation)




From nsiivola at common-lisp.net  Tue Jun 14 10:27:22 2011
From: nsiivola at common-lisp.net (CVS User nsiivola)
Date: Tue, 14 Jun 2011 03:27:22 -0700
Subject: [slime-cvs] CVS slime/contrib
Message-ID: <E1QWQqA-0005E0-Je@common-lisp.net>

Update of /project/slime/cvsroot/slime/contrib
In directory common-lisp.net:/tmp/cvs-serv20084/contrib

Modified Files:
	ChangeLog slime-cl-indent-test.txt slime-cl-indent.el 
Log Message:
slime-indentation: incomplete destructuring tails

  Fixes:

    (let (foo bar
              quux)
      ...)

  to indent as

    (let (foo bar
          quux)
      ...)

  instead.


--- /project/slime/cvsroot/slime/contrib/ChangeLog	2011/06/14 10:26:28	1.482
+++ /project/slime/cvsroot/slime/contrib/ChangeLog	2011/06/14 10:27:22	1.483
@@ -1,5 +1,13 @@
 2011-06-14  Nikodemus Siivola  <nikodemus at random-state.net>
 
+	Fix indentation of incomplete destructring.
+
+	* slime-cl-indent.el (lisp-indent-259): If there's a level of
+	destructuring specified in a tail, but we're looking at a word,
+	indent to sexp instead.
+
+	* slime-cl-indent-test.txt: Test 46.
+
 	Don't consider DEFINER and DEFINITION as tentative defuns.
 
 	* slime-cl-indent.el (common-lisp-indent-function-1): Don't consider
--- /project/slime/cvsroot/slime/contrib/slime-cl-indent-test.txt	2011/06/14 10:26:28	1.7
+++ /project/slime/cvsroot/slime/contrib/slime-cl-indent-test.txt	2011/06/14 10:27:22	1.8
@@ -491,3 +491,9 @@
       bar
       quux)
   ...)
+
+;;; Test: 46
+
+(let (foo bar
+      quux)
+  ...)
--- /project/slime/cvsroot/slime/contrib/slime-cl-indent.el	2011/06/14 10:26:28	1.45
+++ /project/slime/cvsroot/slime/contrib/slime-cl-indent.el	2011/06/14 10:27:22	1.46
@@ -1063,24 +1063,35 @@
                                sexp-column normal-indent)))
               (t
                ;; must be a destructing frob
-               (if (not (null p))
+               (if p
                    ;; descend
                    (setq method (cddr tem)
                          n (car p)
-                         p (cdr p))
-                 (setq tem (cadr tem))
-                 (throw 'exit
-                        (cond (tail
-                               normal-indent)
-                              ((eq tem 'nil)
-                               (list normal-indent
-                                     containing-form-start))
-                              ((integerp tem)
-                               (list (+ sexp-column tem)
-                                     containing-form-start))
-                              (t
-                               (funcall tem path state indent-point
-                                        sexp-column normal-indent)))))))))))
+                         p (cdr p)
+                         tail nil)
+                 (let ((wholep (eq '&whole (car tem))))
+                   (setq tem (cadr tem))
+                   (throw 'exit
+                          (cond (tail
+                                 (if (and wholep (integerp tem)
+                                          (save-excursion
+                                            (goto-char indent-point)
+                                            (back-to-indentation)
+                                            (looking-at "\\sw")))
+                                     ;; There's a further level of
+                                     ;; destructuring, but we're looking at a
+                                     ;; word -- indent to sexp.
+                                     (+ sexp-column tem)
+                                   normal-indent))
+                                ((not tem)
+                                 (list normal-indent
+                                       containing-form-start))
+                                ((integerp tem)
+                                 (list (+ sexp-column tem)
+                                       containing-form-start))
+                                (t
+                                 (funcall tem path state indent-point
+                                          sexp-column normal-indent))))))))))))
 
 (defun lisp-indent-tagbody (path state indent-point sexp-column normal-indent)
   (if (not (null (cdr path)))
@@ -1575,6 +1586,10 @@
       (indent-sexp)
       (if (equal (buffer-string) test)
           t
+        ;; (let ((test-buffer (current-buffer)))
+        ;;   (with-temp-buffer
+        ;;     (insert test)
+        ;;     (ediff-buffers (current-buffer) test-buffer)))
         (error "Bad indentation in test %s.\nMess: %s\nWanted: %s\nGot: %s"
                name
                mess




From nsiivola at common-lisp.net  Tue Jun 14 13:59:31 2011
From: nsiivola at common-lisp.net (CVS User nsiivola)
Date: Tue, 14 Jun 2011 06:59:31 -0700
Subject: [slime-cvs] CVS slime/contrib
Message-ID: <E1QWU9T-0003OU-4V@common-lisp.net>

Update of /project/slime/cvsroot/slime/contrib
In directory common-lisp.net:/tmp/cvs-serv13044/contrib

Modified Files:
	ChangeLog slime-cl-indent-test.txt slime-cl-indent.el 
Log Message:
slime-indentation: with-compilation-unit indentation

  Add indentation method for it.


--- /project/slime/cvsroot/slime/contrib/ChangeLog	2011/06/14 10:27:22	1.483
+++ /project/slime/cvsroot/slime/contrib/ChangeLog	2011/06/14 13:59:31	1.484
@@ -1,5 +1,11 @@
 2011-06-14  Nikodemus Siivola  <nikodemus at random-state.net>
 
+	WITH-COMPILATION-UNIT indentation.
+
+	* slime-cl-indent.el: Add indentation method.
+
+	* slime-cl-indent-test.txt: Test 47.
+
 	Fix indentation of incomplete destructring.
 
 	* slime-cl-indent.el (lisp-indent-259): If there's a level of
--- /project/slime/cvsroot/slime/contrib/slime-cl-indent-test.txt	2011/06/14 10:27:22	1.8
+++ /project/slime/cvsroot/slime/contrib/slime-cl-indent-test.txt	2011/06/14 13:59:31	1.9
@@ -497,3 +497,11 @@
 (let (foo bar
       quux)
   ...)
+
+;;; Test: 47
+
+(with-compilation-unit 
+    (:foo t
+     :quux nil)
+  ...)
+
--- /project/slime/cvsroot/slime/contrib/slime-cl-indent.el	2011/06/14 10:27:22	1.46
+++ /project/slime/cvsroot/slime/contrib/slime-cl-indent.el	2011/06/14 13:59:31	1.47
@@ -1539,6 +1539,7 @@
            (unwind-protect (5 &body))
            (when 1)
            (with-accessors          (as multiple-value-bind))
+           (with-compilation-unit   ((&whole 4 &rest 1) &body))
            (with-condition-restarts (as multiple-value-bind))
            (with-output-to-string (4 2))
            (with-slots              (as multiple-value-bind))




From nsiivola at common-lisp.net  Tue Jun 14 14:00:11 2011
From: nsiivola at common-lisp.net (CVS User nsiivola)
Date: Tue, 14 Jun 2011 07:00:11 -0700
Subject: [slime-cvs] CVS slime
Message-ID: <E1QWUA7-0003hE-0I@common-lisp.net>

Update of /project/slime/cvsroot/slime
In directory common-lisp.net:/tmp/cvs-serv13123

Modified Files:
	ChangeLog slime.el 
Log Message:
slime-indentation: remove stale system indentations

  When updating common-lisp-system-indentation, remove
  old indentation specs from packages which have a new one.


--- /project/slime/cvsroot/slime/ChangeLog	2011/06/10 16:13:28	1.2198
+++ /project/slime/cvsroot/slime/ChangeLog	2011/06/14 14:00:10	1.2199
@@ -1,3 +1,8 @@
+2011-06-14  Nikodemus Siivola  <nikodemus at random-state.net>
+
+	* slime.el (slime-update-system-indentation): Remove stale specs
+	from common-lisp-system-indentation when new one arrives.
+
 2011-06-10  Nikodemus Siivola  <nikodemus at random-state.net>
 
 	* swank.lisp (macro-indentation): Walk the lambda-list
--- /project/slime/cvsroot/slime/slime.el	2011/06/09 16:35:09	1.1371
+++ /project/slime/cvsroot/slime/slime.el	2011/06/14 14:00:10	1.1372
@@ -6933,19 +6933,24 @@
          spec)))
 
 (defun slime-update-system-indentation (symbol indent packages)
-  (let ((list (gethash symbol common-lisp-system-indentation)))
+  (let ((list (gethash symbol common-lisp-system-indentation))
+        (ok nil))
     (if (not list)
         (puthash symbol (list (cons indent packages))
                  common-lisp-system-indentation)
-      (or (dolist (spec list)
-            (when (equal (car spec) indent)
-              (dolist (p packages)
-                (unless (member p (cdr spec))
-                  (push p (cdr spec))))
-              (return t)))
-          (puthash symbol (cons (cons indent packages)
-                                list)
-                   common-lisp-system-indentation)))))
+      (dolist (spec list)
+        (cond ((equal (car spec) indent)
+               (dolist (p packages)
+                 (unless (member p (cdr spec))
+                   (push p (cdr spec))))
+               (setf ok t))
+              (t
+               (setf (cdr spec)
+                     (set-difference (cdr spec) packages :test 'equal)))))
+      (unless ok
+        (puthash symbol (cons (cons indent packages)
+                              list)
+                 common-lisp-system-indentation)))))
 
 (defun slime-handle-indentation-update (alist)
   "Update Lisp indent information.




From nsiivola at common-lisp.net  Tue Jun 14 14:00:37 2011
From: nsiivola at common-lisp.net (CVS User nsiivola)
Date: Tue, 14 Jun 2011 07:00:37 -0700
Subject: [slime-cvs] CVS slime
Message-ID: <E1QWUAX-0003iF-Hy@common-lisp.net>

Update of /project/slime/cvsroot/slime
In directory common-lisp.net:/tmp/cvs-serv14271

Modified Files:
	swank-sbcl.lisp 
Log Message:
sbcl: get compilation notes for recursive entry to compilation right

  When C-c C-c'ing eg. an (EVAL-WHEN ... (REQUIRE :FOO)) form,
  previously we tried to find the position for the note from
  the tempfile.


--- /project/slime/cvsroot/slime/swank-sbcl.lisp	2011/06/09 17:48:47	1.281
+++ /project/slime/cvsroot/slime/swank-sbcl.lisp	2011/06/14 14:00:37	1.282
@@ -410,6 +410,7 @@
 
 
 (defvar *buffer-name* nil)
+(defvar *buffer-tmpfile* nil)
 (defvar *buffer-offset*)
 (defvar *buffer-substring* nil)
 
@@ -492,11 +493,15 @@
 (defun compiling-from-buffer-p (filename)
   (and *buffer-name*
        ;; The following is to trigger COMPILING-FROM-GENERATED-CODE-P
-       ;; in LOCATE-COMPILER-NOTE.
-       (not (eq filename :lisp))))
+       ;; in LOCATE-COMPILER-NOTE, and allows handling nested
+       ;; compilation from eg. hitting C-C on (eval-when ... (require ..))).
+       (pathnamep filename)
+       (string= (namestring filename) *buffer-tmpfile*)))
 
 (defun compiling-from-file-p (filename)
-  (and (pathnamep filename) (null *buffer-name*)))
+  (and (pathnamep filename)
+       (or (null *buffer-name*)
+           (string/= (namestring filename) *buffer-tmpfile*))))
 
 (defun compiling-from-generated-code-p (filename source)
   (and (eq filename :lisp) (stringp source)))
@@ -629,7 +634,7 @@
   (let ((*buffer-name* buffer)
         (*buffer-offset* position)
         (*buffer-substring* string)
-        (temp-file-name (temp-file-name)))
+        (*buffer-tmpfile* (temp-file-name)))
     (flet ((load-it (filename)
              (when filename (load filename)))
            (compile-it (cont)
@@ -642,11 +647,11 @@
                     :source-namestring filename
                     :allow-other-keys t)
                  (multiple-value-bind (output-file warningsp failurep)
-                     (compile-file temp-file-name)
+                     (compile-file *buffer-tmpfile*)
                    (declare (ignore warningsp))
                    (unless failurep
                      (funcall cont output-file)))))))
-      (with-open-file (s temp-file-name :direction :output :if-exists :error)
+      (with-open-file (s *buffer-tmpfile* :direction :output :if-exists :error)
         (write-string string s))
       (unwind-protect
            (with-compiler-policy policy
@@ -654,8 +659,8 @@
                 (compile-it #'load-it)
                 (load-it (compile-it #'identity))))
         (ignore-errors
-          (delete-file temp-file-name)
-          (delete-file (compile-file-pathname temp-file-name)))))))
+          (delete-file *buffer-tmpfile*)
+          (delete-file (compile-file-pathname *buffer-tmpfile*)))))))
 
 ;;;; Definitions
 




From nsiivola at common-lisp.net  Tue Jun 14 14:01:32 2011
From: nsiivola at common-lisp.net (CVS User nsiivola)
Date: Tue, 14 Jun 2011 07:01:32 -0700
Subject: [slime-cvs] CVS slime
Message-ID: <E1QWUBQ-0003jN-F2@common-lisp.net>

Update of /project/slime/cvsroot/slime
In directory common-lisp.net:/tmp/cvs-serv14337

Modified Files:
	ChangeLog swank.lisp 
Log Message:
fix &optional and &key handling in MACRO-INDENTATION

  * Don't count &optional.

  * Deal with &key and &rest identically.


--- /project/slime/cvsroot/slime/ChangeLog	2011/06/14 14:00:10	1.2199
+++ /project/slime/cvsroot/slime/ChangeLog	2011/06/14 14:01:32	1.2200
@@ -1,5 +1,8 @@
 2011-06-14  Nikodemus Siivola  <nikodemus at random-state.net>
 
+	* swank.lisp (macro-indentation): Fix handling of lambda-list
+	keywords other than &rest and &body.
+
 	* slime.el (slime-update-system-indentation): Remove stale specs
 	from common-lisp-system-indentation when new one arrives.
 
--- /project/slime/cvsroot/slime/swank.lisp	2011/06/10 16:13:28	1.745
+++ /project/slime/cvsroot/slime/swank.lisp	2011/06/14 14:01:32	1.746
@@ -3954,7 +3954,9 @@
                        ((eq '&body head)
                         '("&body"))
                        ((member head lambda-list-keywords)
-                        '("&rest" 1))
+                        (if (member head '(&rest &key))
+                            (list "&rest" n)
+                            (walk (cdr list) base)))
                        (t
                         (cons n (walk (cdr list) base))))))))
     (walk arglist t)))




From nsiivola at common-lisp.net  Tue Jun 14 15:34:18 2011
From: nsiivola at common-lisp.net (CVS User nsiivola)
Date: Tue, 14 Jun 2011 08:34:18 -0700
Subject: [slime-cvs] CVS slime
Message-ID: <E1QWVdC-0008Qf-V3@common-lisp.net>

Update of /project/slime/cvsroot/slime
In directory common-lisp.net:/tmp/cvs-serv32401

Modified Files:
	ChangeLog swank-backend.lisp swank-sbcl.lisp swank.lisp 
Log Message:
sbcl: workaround for auto-flush thread deadlocks

 Occasionally auto-flush thread could deadlock with a thread doing
 compilation:

   T1: grabs world-lock
   T2: decides to flush, grabs stream lock
   T1: needs to do output (compiler note, etc), waits on the stream lock
   T2: needs the world-lock for a while (PCL dispatch machinery setup, etc)

   KABOOM.

 This is an SBCL issue, no mistake about it -- but sorting out
 the world-lock handling is going to take a while, and sticking
 a deadline around the FINISH-OUTPUT call avoids the issue.


--- /project/slime/cvsroot/slime/ChangeLog	2011/06/14 14:01:32	1.2200
+++ /project/slime/cvsroot/slime/ChangeLog	2011/06/14 15:34:18	1.2201
@@ -1,5 +1,10 @@
 2011-06-14  Nikodemus Siivola  <nikodemus at random-state.net>
 
+	* swank-backend.lisp (call-with-io-timeout): New DEFINTERFACE.
+	* swank-sbcl.lisp (call-with-io-timeout): DEFIMPLEMENTATION for it.
+	* swank.lisp (auto-flush-loop): Call FINISH-OUTPUT using
+	CALL-WITH-IO-TIMEOUT to prevent deadlocks.
+
 	* swank.lisp (macro-indentation): Fix handling of lambda-list
 	keywords other than &rest and &body.
 
--- /project/slime/cvsroot/slime/swank-backend.lisp	2010/11/07 19:48:21	1.205
+++ /project/slime/cvsroot/slime/swank-backend.lisp	2011/06/14 15:34:18	1.206
@@ -1325,3 +1325,10 @@
 units, but other Lisps return the number of codepoints. The slime
 protocol wants string lengths in terms of codepoints."
   (length string))
+
+;;; Timeouts
+
+(definterface call-with-io-timeout (function &key seconds)
+  "Calls function with the specified IO timeout."
+  (declare (ignore seconds))
+  (funcall function))
--- /project/slime/cvsroot/slime/swank-sbcl.lisp	2011/06/14 14:00:37	1.282
+++ /project/slime/cvsroot/slime/swank-sbcl.lisp	2011/06/14 15:34:18	1.283
@@ -1637,6 +1637,13 @@
                          :dual-channel-p t                         
                          :external-format external-format))
 
+(defimplementation call-with-io-timeout (function &key seconds)
+  (handler-case
+      (sb-sys:with-deadline (:seconds seconds)
+        (funcall function))
+    (sb-sys:deadline-timeout ()
+      nil)))
+
 #-win32
 (defimplementation background-save-image (filename &key restart-function
                                                    completion-function)
--- /project/slime/cvsroot/slime/swank.lisp	2011/06/14 14:01:32	1.746
+++ /project/slime/cvsroot/slime/swank.lisp	2011/06/14 15:34:18	1.747
@@ -1122,11 +1122,15 @@
 
 (defun auto-flush-loop (stream)
   (loop
-   (when (not (and (open-stream-p stream) 
-                   (output-stream-p stream)))
-     (return nil))
-   (finish-output stream)
-   (sleep *auto-flush-interval*)))
+    (when (not (and (open-stream-p stream) 
+                    (output-stream-p stream)))
+      (return nil))
+    ;; Use an IO timeout to avoid deadlocks
+    ;; on the stream we're flushing.
+    (call-with-io-timeout
+     (lambda () (finish-output stream))
+     :seconds 0.1)
+    (sleep *auto-flush-interval*)))
 
 (defun find-repl-thread (connection)
   (cond ((not (use-threads-p))




From sboukarev at common-lisp.net  Wed Jun 15 09:13:21 2011
From: sboukarev at common-lisp.net (CVS User sboukarev)
Date: Wed, 15 Jun 2011 02:13:21 -0700
Subject: [slime-cvs] CVS slime/contrib
Message-ID: <E1QWmA5-0007dX-F2@common-lisp.net>

Update of /project/slime/cvsroot/slime/contrib
In directory common-lisp.net:/tmp/cvs-serv29353

Modified Files:
	ChangeLog slime-scheme.el 
Log Message:
* slime-scheme.el (slime-scheme-indentation-update):
`slime-indentation-update-hooks' now requires functions to accept
three arguments. Add `packages' parameter.


--- /project/slime/cvsroot/slime/contrib/ChangeLog	2011/06/14 13:59:31	1.484
+++ /project/slime/cvsroot/slime/contrib/ChangeLog	2011/06/15 09:13:21	1.485
@@ -1,3 +1,9 @@
+2011-06-15  Stas Boukarev  <stassats at gmail.com>
+
+	* slime-scheme.el (slime-scheme-indentation-update):
+	`slime-indentation-update-hooks' now requires functions to accept
+	three arguments. Add `packages' parameter.
+
 2011-06-14  Nikodemus Siivola  <nikodemus at random-state.net>
 
 	WITH-COMPILATION-UNIT indentation.
--- /project/slime/cvsroot/slime/contrib/slime-scheme.el	2008/01/09 18:30:26	1.1
+++ /project/slime/cvsroot/slime/contrib/slime-scheme.el	2011/06/15 09:13:21	1.2
@@ -15,7 +15,7 @@
 (defun slime-scheme-mode-hook ()
   (slime-mode 1))
 
-(defun slime-scheme-indentation-update (symbol indent)
+(defun slime-scheme-indentation-update (symbol indent packages)
   ;; Does the symbol have an indentation value that we set?
   (when (equal (get symbol 'scheme-indent-function)
 	       (get symbol 'slime-scheme-indent))




From nsiivola at common-lisp.net  Thu Jun 16 08:28:45 2011
From: nsiivola at common-lisp.net (CVS User nsiivola)
Date: Thu, 16 Jun 2011 01:28:45 -0700
Subject: [slime-cvs] CVS slime
Message-ID: <E1QX7wT-0006MD-Kx@common-lisp.net>

Update of /project/slime/cvsroot/slime
In directory common-lisp.net:/tmp/cvs-serv24436

Modified Files:
	ChangeLog swank-sbcl.lisp 
Log Message:
sbcl: compiling from buffer tmpfile directory can be a symlink

 ...so need to PROBE-FILE to make sure the pathnames match before
 comparison.


--- /project/slime/cvsroot/slime/ChangeLog	2011/06/14 15:34:18	1.2201
+++ /project/slime/cvsroot/slime/ChangeLog	2011/06/16 08:28:45	1.2202
@@ -1,3 +1,9 @@
+2011-06-16  Nikodemus Siivola  <nikodemus at random-state.net>
+
+	* swank-sbcl.lisp (compiling-from-buffer-p): PROBE-FILE to
+	handle cases there the tmp-directory is a symlink.
+	(compiling-from-file-p): Ditto.
+
 2011-06-14  Nikodemus Siivola  <nikodemus at random-state.net>
 
 	* swank-backend.lisp (call-with-io-timeout): New DEFINTERFACE.
--- /project/slime/cvsroot/slime/swank-sbcl.lisp	2011/06/14 15:34:18	1.283
+++ /project/slime/cvsroot/slime/swank-sbcl.lisp	2011/06/16 08:28:45	1.284
@@ -495,13 +495,20 @@
        ;; The following is to trigger COMPILING-FROM-GENERATED-CODE-P
        ;; in LOCATE-COMPILER-NOTE, and allows handling nested
        ;; compilation from eg. hitting C-C on (eval-when ... (require ..))).
+       ;;
+       ;; PROBE-FILE to handle tempfile directory being a symlink.
        (pathnamep filename)
-       (string= (namestring filename) *buffer-tmpfile*)))
+       (let ((true1 (probe-file filename))
+             (true2 (probe-file *buffer-tmpfile*)))
+         (and true1 (equal true1 true2)))))
 
 (defun compiling-from-file-p (filename)
   (and (pathnamep filename)
        (or (null *buffer-name*)
-           (string/= (namestring filename) *buffer-tmpfile*))))
+           (null *buffer-tmpfile*)
+           (let ((true1 (probe-file filename))
+                 (true2 (probe-file *buffer-tmpfile*)))
+             (not (and true1 (equal true1 true2)))))))
 
 (defun compiling-from-generated-code-p (filename source)
   (and (eq filename :lisp) (stringp source)))




From nsiivola at common-lisp.net  Thu Jun 16 08:29:17 2011
From: nsiivola at common-lisp.net (CVS User nsiivola)
Date: Thu, 16 Jun 2011 01:29:17 -0700
Subject: [slime-cvs] CVS slime
Message-ID: <E1QX7wz-0006N8-Kg@common-lisp.net>

Update of /project/slime/cvsroot/slime
In directory common-lisp.net:/tmp/cvs-serv24494

Modified Files:
	ChangeLog swank.lisp 
Log Message:
macro-indentation: try to sort it out

 * Restore old default.

 * Give slime-indentation the more complex one, and try to address the issues
   of the previous attempt at complexity.


--- /project/slime/cvsroot/slime/ChangeLog	2011/06/16 08:28:45	1.2202
+++ /project/slime/cvsroot/slime/ChangeLog	2011/06/16 08:29:17	1.2203
@@ -1,5 +1,7 @@
 2011-06-16  Nikodemus Siivola  <nikodemus at random-state.net>
 
+	* swank.lisp (macro-indentation): Restore the old simple version.
+
 	* swank-sbcl.lisp (compiling-from-buffer-p): PROBE-FILE to
 	handle cases there the tmp-directory is a symlink.
 	(compiling-from-file-p): Ditto.
--- /project/slime/cvsroot/slime/swank.lisp	2011/06/14 15:34:18	1.747
+++ /project/slime/cvsroot/slime/swank.lisp	2011/06/16 08:29:17	1.748
@@ -3948,22 +3948,9 @@
       nil))
 
 (defun macro-indentation (arglist)
-  (labels ((walk (list &optional base)
-             (when (consp list)
-               (let ((head (car list))
-                     (n (if base 4 1)))
-                 (cond ((consp head)
-                        (let ((indent (walk head)))
-                          (cons (list* "&whole" n indent) (walk (cdr list) base))))
-                       ((eq '&body head)
-                        '("&body"))
-                       ((member head lambda-list-keywords)
-                        (if (member head '(&rest &key))
-                            (list "&rest" n)
-                            (walk (cdr list) base)))
-                       (t
-                        (cons n (walk (cdr list) base))))))))
-    (walk arglist t)))
+  (if (well-formed-list-p arglist)
+      (position '&body (remove '&optional (clean-arglist arglist)))
+      nil))
 
 (defun clean-arglist (arglist)
   "Remove &whole, &enviroment, and &aux elements from ARGLIST."




From nsiivola at common-lisp.net  Thu Jun 16 08:29:17 2011
From: nsiivola at common-lisp.net (CVS User nsiivola)
Date: Thu, 16 Jun 2011 01:29:17 -0700
Subject: [slime-cvs] CVS slime/contrib
Message-ID: <E1QX7wz-0006NP-RQ@common-lisp.net>

Update of /project/slime/cvsroot/slime/contrib
In directory common-lisp.net:/tmp/cvs-serv24494/contrib

Modified Files:
	ChangeLog swank-indentation.lisp 
Log Message:
macro-indentation: try to sort it out

 * Restore old default.

 * Give slime-indentation the more complex one, and try to address the issues
   of the previous attempt at complexity.


--- /project/slime/cvsroot/slime/contrib/ChangeLog	2011/06/15 09:13:21	1.485
+++ /project/slime/cvsroot/slime/contrib/ChangeLog	2011/06/16 08:29:17	1.486
@@ -1,3 +1,9 @@
+2011-06-16  Nikodemus Siivola  <nikodemus at random-state.net>
+
+	* swank-indentation.lisp (macro-indentation): More complex
+	version than the default. Fixes some of the misbehaviour of
+	the previous complex version.
+
 2011-06-15  Stas Boukarev  <stassats at gmail.com>
 
 	* slime-scheme.el (slime-scheme-indentation-update):
--- /project/slime/cvsroot/slime/contrib/swank-indentation.lisp	2011/05/21 17:01:44	1.3
+++ /project/slime/cvsroot/slime/contrib/swank-indentation.lisp	2011/06/16 08:29:17	1.4
@@ -45,4 +45,90 @@
           (macro-indentation arglist)))))
     (t nil)))
 
+;;; More complex version.
+(defun macro-indentation (arglist)
+  (labels ((frob (list)
+             (if (every (lambda (x)
+                          (member x '(nil "&rest") :test #'equal))
+                        list)
+                 ;; If there was nothing interesting, don't return anything.
+                 nil
+                 ;; Otherwise substitute leading NIL's with 4.
+                 (let ((ok t))
+                   (substitute-if 4 (lambda (x)
+                                      (if (and ok (not x))
+                                          t
+                                          (setf ok nil)))
+                                  list))))
+           (walk (list level &optional firstp)
+             (when (consp list)
+               (let ((head (car list)))
+                 (if (consp head)
+                     (let ((indent (frob (walk head (+ level 1) t))))
+                       (cons (list* "&whole" 4 indent) (walk (cdr list) level)))
+                     (case head
+                       ;; &BODY is &BODY, this is clear.
+                       (&body
+                        '("&body"))
+                       ;; &KEY is tricksy. If it's at the base level, we want
+                       ;; to indent them normally:
+                       ;;
+                       ;;  (foo bar quux
+                       ;;       :quux t
+                       ;;       :zot nil)
+                       ;;
+                       ;; If it's at a destructuring level, we want indent of 1:
+                       ;;
+                       ;;  (with-foo (var arg
+                       ;;             :foo t
+                       ;;             :quux nil)
+                       ;;     ...)
+                       (&key
+                        (if (zerop level)
+                            '("&rest" nil)
+                            '("&rest" 1)))
+                       ;; &REST is tricksy. If it's at the front of
+                       ;; destructuring, we want to indent by 1, otherwise
+                       ;; normally:
+                       ;;
+                       ;;  (foo (bar quux
+                       ;;        zot)
+                       ;;    ...)
+                       ;;
+                       ;; but
+                       ;;
+                       ;;  (foo bar quux
+                       ;;       zot)
+                       (&rest
+                        (if (and (plusp level) firstp)
+                            '("&rest" 1)
+                            '("&rest" nil)))
+                       ;; &WHOLE and &ENVIRONMENT are skipped as if they weren't there
+                       ;; at all.
+                       ((&whole &environment)
+                        (walk (cddr list) level firstp))
+                       ;; &OPTIONAL is indented normally -- and the &OPTIONAL marker
+                       ;; itself is not counted.
+                       (&optional
+                        (walk (cdr list) level))
+                       ;; Indent normally, walk the tail -- but
+                       ;; unknown lambda-list keywords terminate the walk.
+                       (otherwise
+                        (unless (member head lambda-list-keywords)
+                          (cons nil (walk (cdr list) level))))))))))
+    (frob (walk arglist 0 t))))
+
+#+nil
+(progn
+  (assert (equal '(4 4 ("&whole" 4 "&rest" 1) "&body")
+                 (macro-indentation '(bar quux (&rest slots) &body body))))
+  (assert (equal nil
+                 (macro-indentation '(a b c &rest more))))
+  (assert (equal '(4 4 4 "&body")
+                 (macro-indentation '(a b c &body more))))
+  (assert (equal '(("&whole" 4 4 4 "&rest" 1) "&body")
+                 (macro-indentation '((name zot &key foo bar) &body body))))
+  (assert (equal nil
+                 (macro-indentation '(x y &key z)))))
+
 (provide :swank-indentation)




From nsiivola at common-lisp.net  Sat Jun 18 11:51:22 2011
From: nsiivola at common-lisp.net (CVS User nsiivola)
Date: Sat, 18 Jun 2011 04:51:22 -0700
Subject: [slime-cvs] CVS slime
Message-ID: <E1QXu3e-0005FT-Sy@common-lisp.net>

Update of /project/slime/cvsroot/slime
In directory common-lisp.net:/tmp/cvs-serv20168

Modified Files:
	ChangeLog swank.lisp 
Log Message:
swank: lock around updating the indentation cache

  Hash-tables aren't necessarily thread safe. (Yes, I actually
  saw the table get corrupted -- this isn't just theoretical.)


--- /project/slime/cvsroot/slime/ChangeLog	2011/06/16 08:29:17	1.2203
+++ /project/slime/cvsroot/slime/ChangeLog	2011/06/18 11:51:22	1.2204
@@ -1,3 +1,12 @@
+2011-06-18  Nikodemus Siivola  <nikodemus at random-state.net>
+
+	* swank.lisp (*indentation-cache-lock*): New variable:
+	hash-table updates aren't necessarily thread-safe.
+	(perform-indentation-update, update-indentation/delta-for-emacs):
+	Grab the lock when necessary -- in delta-for-emacs we hold on to
+	it a bit longer than necessary, but the code is easier to read
+	this way.
+
 2011-06-16  Nikodemus Siivola  <nikodemus at random-state.net>
 
 	* swank.lisp (macro-indentation): Restore the old simple version.
--- /project/slime/cvsroot/slime/swank.lisp	2011/06/16 08:29:17	1.748
+++ /project/slime/cvsroot/slime/swank.lisp	2011/06/18 11:51:22	1.749
@@ -3867,6 +3867,10 @@
   "When true, automatically send indentation information to Emacs
 after each command.")
 
+(defvar *indentation-cache-lock*
+  ;; Hash-tables aren't necessarily thread safe.
+  (make-lock :name "Indentation Cache Lock"))
+
 (defslimefun update-indentation-information ()
   (perform-indentation-update *emacs-connection* t)
   nil)
@@ -3889,7 +3893,9 @@
   "Update the indentation cache in CONNECTION and update Emacs.
 If FORCE is true then start again without considering the old cache."
   (let ((cache (connection.indentation-cache connection)))
-    (when force (clrhash cache))
+    (when force
+      (call-with-lock-held 
+       *indentation-cache-lock* (lambda () (clrhash cache))))
     (let ((delta (update-indentation/delta-for-emacs cache force)))
       (setf (connection.indentation-cache-packages connection)
             (list-all-packages))
@@ -3904,13 +3910,16 @@
     (flet ((consider (symbol)
              (let ((indent (symbol-indentation symbol)))
                (when indent
-                 (unless (equal (gethash symbol cache) indent)
-                   (setf (gethash symbol cache) indent)
-                   (let ((pkgs (loop for p in (list-all-packages)
-                                     when (eq symbol (find-symbol (string symbol) p))
-                                     collect (package-name p)))
-                         (name (string-downcase symbol)))
-                     (push (list name indent pkgs) alist)))))))
+                 (call-with-lock-held
+                  *indentation-cache-lock*
+                  (lambda ()
+                    (unless (equal (gethash symbol cache) indent)
+                      (setf (gethash symbol cache) indent)
+                      (let ((pkgs (loop for p in (list-all-packages)
+                                        when (eq symbol (find-symbol (string symbol) p))
+                                        collect (package-name p)))
+                            (name (string-downcase symbol)))
+                        (push (list name indent pkgs) alist)))))))))
       (if force
           (do-all-symbols (symbol)
             (consider symbol))




From nsiivola at common-lisp.net  Tue Jun 21 11:24:02 2011
From: nsiivola at common-lisp.net (CVS User nsiivola)
Date: Tue, 21 Jun 2011 04:24:02 -0700
Subject: [slime-cvs] CVS slime
Message-ID: <E1QYz3q-0001MS-16@common-lisp.net>

Update of /project/slime/cvsroot/slime
In directory common-lisp.net:/tmp/cvs-serv5232

Modified Files:
	ChangeLog swank.lisp 
Log Message:
swank: thread-safe indentation update without explicit locks

 * Spawn a new thread to perform the indentation update.

 * In the new thread, if we need to write to the cache, copy
   it first. This makes the cache read-only by the time other
   threads can see it -- so in the worst case we will only have
   parallel readers, not readers-and-writers.

 * Remove *INDENTATION-CACHE-LOCK*.


--- /project/slime/cvsroot/slime/ChangeLog	2011/06/18 11:51:22	1.2204
+++ /project/slime/cvsroot/slime/ChangeLog	2011/06/21 11:24:01	1.2205
@@ -1,3 +1,15 @@
+2011-06-21  Nikodemus Siivola  <nikodemus at random-state.net>
+
+	* swank.lisp (*indentation-cache-lock*): Deleted.
+	(perform-indentation-update): Spawn a new thread to handle the
+	indentation update when using threads. Move cache-clearing to
+	UPDATE-INDENTATION/DELTA-FOR-EMACS. Replace the old cache by
+	the one returned from U-I/D-F-E.
+	(update-indentation/delta-for-emacs): When clearing the cache,
+	allocate a new table. When threads are being used, copy the
+	cache before mutation, to ensure that caches possibly seen by other
+	threads are write-only by then.
+
 2011-06-18  Nikodemus Siivola  <nikodemus at random-state.net>
 
 	* swank.lisp (*indentation-cache-lock*): New variable:
--- /project/slime/cvsroot/slime/swank.lisp	2011/06/18 11:51:22	1.749
+++ /project/slime/cvsroot/slime/swank.lisp	2011/06/21 11:24:01	1.750
@@ -3867,10 +3867,6 @@
   "When true, automatically send indentation information to Emacs
 after each command.")
 
-(defvar *indentation-cache-lock*
-  ;; Hash-tables aren't necessarily thread safe.
-  (make-lock :name "Indentation Cache Lock"))
-
 (defslimefun update-indentation-information ()
   (perform-indentation-update *emacs-connection* t)
   nil)
@@ -3892,43 +3888,63 @@
 (defun perform-indentation-update (connection force)
   "Update the indentation cache in CONNECTION and update Emacs.
 If FORCE is true then start again without considering the old cache."
-  (let ((cache (connection.indentation-cache connection)))
-    (when force
-      (call-with-lock-held 
-       *indentation-cache-lock* (lambda () (clrhash cache))))
-    (let ((delta (update-indentation/delta-for-emacs cache force)))
-      (setf (connection.indentation-cache-packages connection)
-            (list-all-packages))
-      (unless (null delta)
-        (send-to-emacs (list :indentation-update delta))))))
+  (let ((pkg *buffer-package*))
+    (flet ((perform-it ()
+             (let ((cache (connection.indentation-cache connection))
+                   ;; Rebind for spawned thread.
+                   (*emacs-connection* connection)
+                   (*buffer-package* pkg))
+               (multiple-value-bind (delta cache)
+                   (update-indentation/delta-for-emacs cache force)
+                 (setf (connection.indentation-cache-packages connection)
+                       (list-all-packages))
+                 (unless (null delta)
+                   (setf (connection.indentation-cache connection) cache)
+                   (send-to-emacs (list :indentation-update delta)))))))
+      (if (use-threads-p)
+          (spawn #'perform-it :name "indentation-update-thread")
+          (perform-it)))))
 
 (defun update-indentation/delta-for-emacs (cache &optional force)
   "Update the cache and return the changes in a (SYMBOL INDENT PACKAGES) list.
 If FORCE is true then check all symbols, otherwise only check symbols
 belonging to the buffer package."
-  (let ((alist '()))
+  (let ((alist '())
+        (must-copy (use-threads-p)))
+    ;; The hash-table copying hair here is to ensure no two threads ever
+    ;; operate on the same hash-table -- except in the worst case with
+    ;; parallel readers. (Hash-tables aren't guaranteed to be thread-safe at
+    ;; all, but we make the hopefully-portable assumption that parallel
+    ;; readers are OK.)
     (flet ((consider (symbol)
              (let ((indent (symbol-indentation symbol)))
                (when indent
-                 (call-with-lock-held
-                  *indentation-cache-lock*
-                  (lambda ()
-                    (unless (equal (gethash symbol cache) indent)
-                      (setf (gethash symbol cache) indent)
-                      (let ((pkgs (loop for p in (list-all-packages)
-                                        when (eq symbol (find-symbol (string symbol) p))
-                                        collect (package-name p)))
-                            (name (string-downcase symbol)))
-                        (push (list name indent pkgs) alist)))))))))
-      (if force
-          (do-all-symbols (symbol)
-            (consider symbol))
-          (do-symbols (symbol *buffer-package*)
-            ;; We're really just interested in the symbols of *BUFFER-PACKAGE*,
-            ;; and *not* all symbols that are _present_ (cf. SYMBOL-STATUS.)
-            (when (eq (symbol-package symbol) *buffer-package*)
-              (consider symbol)))))
-    alist))
+                 (unless (equal (gethash symbol cache) indent)
+                   (when must-copy
+                     (setf cache (let ((new (make-hash-table :test #'eq)))
+                                   (maphash (lambda (k v)
+                                              (setf (gethash k new) v))
+                                            cache)
+                                   new)
+                           must-copy nil))
+                   (setf (gethash symbol cache) indent)
+                   (let ((pkgs (loop for p in (list-all-packages)
+                                     when (eq symbol (find-symbol (string symbol) p))
+                                     collect (package-name p)))
+                         (name (string-downcase symbol)))
+                     (push (list name indent pkgs) alist)))))))
+      (cond (force
+             (setf cache (make-hash-table :test 'eq)
+                   must-copy nil)
+             (do-all-symbols (symbol)
+               (consider symbol)))
+            (t
+             (do-symbols (symbol *buffer-package*)
+               ;; We're really just interested in the symbols of *BUFFER-PACKAGE*,
+               ;; and *not* all symbols that are _present_ (cf. SYMBOL-STATUS.)
+               (when (eq (symbol-package symbol) *buffer-package*)
+                 (consider symbol)))))
+      (values alist cache))))
 
 (defun package-names (package)
   "Return the name and all nicknames of PACKAGE in a fresh list."




From nsiivola at common-lisp.net  Tue Jun 21 11:49:37 2011
From: nsiivola at common-lisp.net (CVS User nsiivola)
Date: Tue, 21 Jun 2011 04:49:37 -0700
Subject: [slime-cvs] CVS slime/contrib
Message-ID: <E1QYzSb-00025q-8U@common-lisp.net>

Update of /project/slime/cvsroot/slime/contrib
In directory common-lisp.net:/tmp/cvs-serv8046/contrib

Modified Files:
	ChangeLog slime-cl-indent.el 
Log Message:
slime-indentation: small fixes

 * Two defcustoms had wrong types.

 * Make the common-lisp-style-default offer a dropdown menu in the
   customization group.

 * "sbcl" style used :as instead of as, and missed defmacro-mundanely
   and define-source-transform.


--- /project/slime/cvsroot/slime/contrib/ChangeLog	2011/06/16 08:29:17	1.486
+++ /project/slime/cvsroot/slime/contrib/ChangeLog	2011/06/21 11:49:37	1.487
@@ -1,3 +1,11 @@
+2011-06-21  Nikodemus Siivola  <nikodemus at random-state.net>
+
+	* slime-cl-indent.el (lisp-loop-indent-forms-like-keywords): Fix type error.
+	(common-lisp-style-default): Fix type error, move to after styles have been
+	defined so as to be able to offer a menu for picking the predefined styles.
+	("sbcl"): Oops! It's (as ...) not (:as ...). Also add couple of missing defining
+	forms.
+
 2011-06-16  Nikodemus Siivola  <nikodemus at random-state.net>
 
 	* swank-indentation.lisp (macro-indentation): More complex
--- /project/slime/cvsroot/slime/contrib/slime-cl-indent.el	2011/06/14 13:59:31	1.47
+++ /project/slime/cvsroot/slime/contrib/slime-cl-indent.el	2011/06/21 11:49:37	1.48
@@ -82,7 +82,7 @@
   "Whether or not to indent loop subforms just like
 loop keywords. Only matters when `lisp-loop-indent-subclauses'
 is nil."
-  :type 'integer
+  :type 'boolean
   :group 'lisp-indent)
 
 (defcustom lisp-align-keywords-in-calls t
@@ -225,12 +225,6 @@
 buffer has no style specified, but `common-lisp-style-default' is set, that
 style is used instead. Use `define-common-lisp-style' to define new styles.")
 
-(defcustom common-lisp-style-default nil
-    "Name of the Common Lisp indentation style to use in lisp-mode buffers if
-none has been specified."
-  :type 'string
-  :group 'lisp-indent)
-
 (make-variable-buffer-local 'common-lisp-style)
 (set-default 'common-lisp-style nil)
 
@@ -481,12 +475,23 @@
    (comment-fill-column nil)
    (fill-column 78))
   (:indentation
-   (def!constant       (:as defconstant))
-   (def!macro          (:as defmacro))
-   (def!method         (:as defmethod))
-   (def!struct         (:as defstruct))
-   (def!type           (:as deftype))
-   (defmacro-mundanely (:as defmacro))))
+   (def!constant       (as defconstant))
+   (def!macro          (as defmacro))
+   (def!method         (as defmethod))
+   (def!struct         (as defstruct))
+   (def!type           (as deftype))
+   (defmacro-mundanely (as defmacro))
+   (define-source-transform (as defun))))
+
+(defcustom common-lisp-style-default nil
+    "Name of the Common Lisp indentation style to use in lisp-mode buffers if
+none has been specified."
+  :type `(choice (const :tag "None" nil)
+                 ,@(mapcar (lambda (spec)
+                             `(const :tag ,(car spec) ,(car spec)))
+                           (common-lisp-style-names))
+                 (string :tag "Other"))
+  :group 'lisp-indent)
 
 ;;;; The indentation specs are stored at three levels. In order of priority:
 ;;;;