X-Git-Url: https://code.delx.au/gnu-emacs/blobdiff_plain/f8f34fa23d98857a12027159bb5558a7e15ef14e..b1b2ae81628a5edce8492e5e1004de8f2a15830d:/lisp/emacs-lisp/cl-indent.el

diff --git a/lisp/emacs-lisp/cl-indent.el b/lisp/emacs-lisp/cl-indent.el
index dd5586dbd2..2e6265d4df 100644
--- a/lisp/emacs-lisp/cl-indent.el
+++ b/lisp/emacs-lisp/cl-indent.el
@@ -1,6 +1,6 @@
 ;;; cl-indent.el --- enhanced lisp-indent mode
 
-;; Copyright (C) 1987 Free Software Foundation, Inc.
+;; Copyright (C) 1987, 2000, 2001, 2002 Free Software Foundation, Inc.
 
 ;; Author: Richard Mlynarik <mly@eddie.mit.edu>
 ;; Created: July 1987
@@ -78,11 +78,71 @@ by `lisp-body-indent'."
   :type 'integer
   :group 'lisp-indent)
 
+(defcustom lisp-backquote-indentation t
+  "*Whether or not to indent backquoted lists as code.
+If nil, indent backquoted lists as data, i.e., like quoted lists."
+  :type 'boolean
+  :group 'lisp-indent)
+
+
+(defcustom lisp-loop-keyword-indentation 3
+  "*Indentation of loop keywords in extended loop forms."
+  :type 'integer
+  :group 'lisp-indent)
+
+
+(defcustom lisp-loop-forms-indentation 5
+  "*Indentation of forms in extended loop forms."
+  :type 'integer
+  :group 'lisp-indent)
+
+
+(defcustom lisp-simple-loop-indentation 3
+  "*Indentation of forms in simple loop forms."
+  :type 'integer
+  :group 'lisp-indent)
+
 
 (defvar lisp-indent-error-function)
+(defvar lisp-indent-defun-method '(4 &lambda &body))
+
+
+(defun extended-loop-p (loop-start)
+  "True if an extended loop form starts at LOOP-START."
+  (condition-case ()
+      (save-excursion
+	(goto-char loop-start)
+	(forward-char 1)
+	(forward-sexp 2)
+	(backward-sexp 1)
+	(looking-at "\\sw"))
+    (error t)))
+
+
+(defun common-lisp-loop-part-indentation (indent-point state)
+  "Compute the indentation of loop form constituents."
+  (let* ((loop-indentation (save-excursion
+			     (goto-char (elt state 1))
+			     (current-column))))
+    (goto-char indent-point)
+    (beginning-of-line)
+    (cond ((not (extended-loop-p (elt state 1)))
+	   (+ loop-indentation lisp-simple-loop-indentation))
+	  ((looking-at "^\\s-*\\(:?\\sw+\\|;\\)")
+	   (+ loop-indentation lisp-loop-keyword-indentation))
+	  (t
+	   (+ loop-indentation lisp-loop-forms-indentation)))))
+
 
 ;;;###autoload
 (defun common-lisp-indent-function (indent-point state)
+  (if (save-excursion (goto-char (elt state 1))
+		      (looking-at "([Ll][Oo][Oo][Pp]"))
+      (common-lisp-loop-part-indentation indent-point state)
+    (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
     ;;  which does special things with subforms.
@@ -93,7 +153,10 @@ by `lisp-body-indent'."
           (path ())
           ;; set non-nil when somebody works out the indentation to use
           calculated
-          (last-point indent-point)
+	  ;; If non-nil, this is an indentation to use
+	  ;; if nothing else specifies it more firmly.
+	  tentative-calculated
+	  (last-point indent-point)
           ;; the position of the open-paren of the innermost containing list
           (containing-form-start (elt state 1))
           ;; the column of the above
@@ -101,6 +164,7 @@ by `lisp-body-indent'."
       ;; Move to start of innermost containing list
       (goto-char containing-form-start)
       (setq sexp-column (current-column))
+
       ;; Look over successively less-deep containing forms
       (while (and (not calculated)
                   (< depth lisp-indent-maximum-backtracking))
@@ -108,13 +172,14 @@ by `lisp-body-indent'."
           (forward-char 1)
           (parse-partial-sexp (point) indent-point 1 t)
           ;; Move to the car of the relevant containing form
-          (let (tem function method)
+          (let (tem 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 tem (point))
               (forward-sexp 1)
-              (setq function (downcase (buffer-substring tem (point))))
+              (setq function (downcase (buffer-substring-no-properties
+                                        tem (point))))
               (goto-char tem)
               (setq tem (intern-soft function)
                     method (get tem 'common-lisp-indent-function))
@@ -146,31 +211,52 @@ by `lisp-body-indent'."
             ;; backwards compatibility.
             (cond ((null function))
                   ((null method)
-                   (if (null (cdr path))
-                       ;; (package prefix was stripped off above)
-                       (setq method (cond ((string-match "\\`def"
-                                                         function)
-                                           '(4 (&whole 4 &rest 1) &body))
-                                          ((string-match "\\`\\(with\\|do\\)-"
-                                                         function)
-                                           '(4 &body))))))
+                   (when (null (cdr path))
+		     ;; (package prefix was stripped off above)
+		     (cond ((string-match "\\`def"
+					  function)
+			    (setq tentative-defun t))
+			   ((string-match "\\`\\(with\\|do\\)-"
+					  function)
+			    (setq method '(&lambda &body))))))
                   ;; backwards compatibility.  Bletch.
                   ((eq method 'defun)
-                   (setq method '(4 (&whole 4 &rest 1) &body))))
+                   (setq method lisp-indent-defun-method)))
 
-            (cond ((and (memq (char-after (1- containing-sexp)) '(?\' ?\`))
-                        (not (eql (char-after (- containing-sexp 2)) ?\#)))
+            (cond ((and (or (eq (char-after (1- containing-sexp)) ?\')
+			    (and (not lisp-backquote-indentation)
+				 (eq (char-after (1- containing-sexp)) ?\`)))
+                        (not (eq (char-after (- containing-sexp 2)) ?\#)))
                    ;; No indentation for "'(...)" elements
                    (setq calculated (1+ sexp-column)))
-		  ((or (eql (char-after (1- containing-sexp)) ?\,)
-		       (and (eql (char-after (1- containing-sexp)) ?\@)
-			    (eql (char-after (- containing-sexp 2)) ?\,)))
-		   ;; ",(...)" or ",@(...)"
-		   (setq calculated normal-indent))
-                  ((eql (char-after (1- containing-sexp)) ?\#)
+                  ((or (eq (char-after (1- containing-sexp)) ?\,)
+                       (and (eq (char-after (1- containing-sexp)) ?\@)
+                            (eq (char-after (- containing-sexp 2)) ?\,)))
+                   ;; ",(...)" or ",@(...)"
+                   (setq calculated normal-indent))
+                  ((eq (char-after (1- containing-sexp)) ?\#)
                    ;; "#(...)"
                    (setq calculated (1+ sexp-column)))
-                  ((null method))
+                  ((null method)
+		   ;; If this looks like a call to a `def...' form,
+		   ;; think about indenting it as one, but do it
+		   ;; tentatively for cases like
+		   ;; (flet ((defunp ()
+		   ;;          nil)))
+		   ;; Set both normal-indent and tentative-calculated.
+		   ;; The latter ensures this value gets used
+		   ;; if there are no relevant containing constructs.
+		   ;; The former ensures this value gets used
+		   ;; if there is a relevant containing construct
+		   ;; but we are nested within the structure levels
+		   ;; that it specifies indentation for.
+		   (if tentative-defun
+		       (setq tentative-calculated
+			     (common-lisp-indent-call-method
+			      function lisp-indent-defun-method
+			      path state indent-point
+			      sexp-column normal-indent)
+			     normal-indent tentative-calculated)))
                   ((integerp method)
                    ;; convenient top-level hack.
                    ;;  (also compatible with lisp-indent-function)
@@ -189,25 +275,30 @@ by `lisp-body-indent'."
                                           (t
                                            ;; other body form
                                            normal-indent))))
-                  ((symbolp method)
-		   (let ((lisp-indent-error-function function))
-		     (setq calculated (funcall method
-					       path state indent-point
-					       sexp-column normal-indent))))
-                  (t
-		   (let ((lisp-indent-error-function function))
-		     (setq calculated (lisp-indent-259
-				       method path state indent-point
-				       sexp-column normal-indent))))))
+		  (t
+		   (setq calculated
+			 (common-lisp-indent-call-method
+			  function method path state indent-point
+			  sexp-column normal-indent)))))
           (goto-char containing-sexp)
           (setq last-point containing-sexp)
-          (if (not calculated)
-              (condition-case ()
-                   (progn (backward-up-list 1)
-                          (setq depth (1+ depth)))
-                (error (setq depth lisp-indent-maximum-backtracking))))))
-      calculated)))
-
+          (unless calculated
+	    (condition-case ()
+		(progn (backward-up-list 1)
+		       (setq depth (1+ depth)))
+	      (error (setq depth lisp-indent-maximum-backtracking))))))
+      (or calculated tentative-calculated))))
+
+
+(defun common-lisp-indent-call-method (function method path state indent-point
+				       sexp-column normal-indent)
+  (let ((lisp-indent-error-function function))
+    (if (symbolp method)
+	(funcall method
+		 path state indent-point
+		 sexp-column normal-indent)
+      (lisp-indent-259 method path state indent-point
+		       sexp-column normal-indent))))
 
 (defun lisp-indent-report-bad-format (m)
   (error "%s has a badly-formed %s property: %s"
@@ -239,15 +330,16 @@ by `lisp-body-indent'."
           (setq tem (car method))
 
           (or (eq tem 'nil)             ;default indentation
-;             (eq tem '&lambda)         ;abbrev for (&whole 4 (&rest 1))
+              (eq tem '&lambda)         ;lambda list
               (and (eq tem '&body) (null (cdr method)))
               (and (eq tem '&rest)
-                   (consp (cdr method)) (null (cdr (cdr method))))
+                   (consp (cdr method))
+                   (null (cddr method)))
               (integerp tem)            ;explicit indentation specified
               (and (consp tem)          ;destructuring
                    (eq (car tem) '&whole)
-                   (or (symbolp (car (cdr tem)))
-                       (integerp (car (cdr tem)))))
+                   (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))
@@ -277,14 +369,13 @@ by `lisp-body-indent'."
                      (throw 'exit normal-indent)))
                 ((eq tem 'nil)
                  (throw 'exit (list normal-indent containing-form-start)))
-;               ((eq tem '&lambda)
-;                ;; abbrev for (&whole 4 &rest 1)
-;                (throw 'exit
-;                  (cond ((null p)
-;                         (list (+ sexp-column 4) containing-form-start))
-;                        ((null (cdr p))
-;                         (+ sexp-column 1))
-;                        (t normal-indent))))
+          ((eq tem '&lambda)
+           (throw 'exit
+             (cond ((null p)
+                    (list (+ sexp-column 4) containing-form-start))
+                   ((null (cdr p))
+                    (+ sexp-column 1))
+                   (t normal-indent))))
                 ((integerp tem)
                  (throw 'exit
                    (if (null p)         ;not in subforms
@@ -298,9 +389,9 @@ by `lisp-body-indent'."
                  ;; must be a destructing frob
                  (if (not (null p))
                      ;; descend
-                     (setq method (cdr (cdr tem))
+               (setq method (cddr tem)
                            n nil)
-                   (setq tem (car (cdr tem)))
+               (setq tem (cadr tem))
                    (throw 'exit
                      (cond (tail
                             normal-indent)
@@ -344,14 +435,30 @@ by `lisp-body-indent'."
   (if (>= (car path) 3)
       (let ((lisp-tag-body-indentation lisp-body-indent))
         (funcall (function lisp-indent-tagbody)
-		 path state indent-point sexp-column normal-indent))
+                 path state indent-point sexp-column normal-indent))
     (funcall (function lisp-indent-259)
-	     '((&whole nil &rest
- 		;; the following causes weird indentation
- 		;;(&whole 1 1 2 nil)
-		)
-	       (&whole nil &rest 1))
-	     path state indent-point sexp-column normal-indent)))
+             '((&whole nil &rest
+                ;; the following causes weird indentation
+                ;;(&whole 1 1 2 nil)
+                )
+               (&whole nil &rest 1))
+             path state indent-point sexp-column normal-indent)))
+
+
+(defun lisp-indent-defmethod (path state indent-point sexp-column
+				   normal-indent)
+  "Indentation function defmethod."
+  (lisp-indent-259 (if (and (>= (car path) 3)
+                            (null (cdr path))
+			    (save-excursion (goto-char (elt state 1))
+					    (forward-char 1)
+                                            (forward-sexp 3)
+                                            (backward-sexp)
+					    (looking-at ":")))
+		       '(4 4 (&whole 4 &rest 4) &body)
+		     (get 'defun 'common-lisp-indent-function))
+		   path state indent-point sexp-column normal-indent))
+
 
 (defun lisp-indent-function-lambda-hack (path state indent-point
                                          sexp-column normal-indent)
@@ -371,81 +478,88 @@ by `lisp-body-indent'."
               (+ sexp-column lisp-body-indent)))
        (error (+ sexp-column lisp-body-indent)))))
 
+
 
 (let ((l '((block 1)
-	   (catch 1)
-	   (case        (4 &rest (&whole 2 &rest 1)))
-	   (ccase . case) (ecase . case)
-	   (typecase . case) (etypecase . case) (ctypecase . case)
-	   (catch 1)
-	   (cond        (&rest (&whole 2 &rest 1)))
-	   (block 1)
-	   (defvar      (4 2 2))
-	   (defconstant . defvar)
-	   (defparameter . defvar)
-	   (define-modify-macro
-			(4 &body))
-	   (define-setf-method
-			(4 (&whole 4 &rest 1) &body))
-	   (defsetf     (4 (&whole 4 &rest 1) 4 &body))
-	   (defun       (4 (&whole 4 &rest 1) &body))
-	   (defmacro . defun) (deftype . defun)
-	   (defpackage  (4 2))
-	   (defstruct   ((&whole 4 &rest (&whole 2 &rest 1))
-			 &rest (&whole 2 &rest 1)))
-	   (destructuring-bind
-			((&whole 6 &rest 1) 4 &body))
-	   (do          lisp-indent-do)
-	   (do* . do)
-	   (dolist      ((&whole 4 2 1) &body))
-	   (dotimes . dolist)
-	   (eval-when	1)
-	   (flet        ((&whole 4 &rest (&whole 1 (&whole 4 &rest 1) &body))
-			 &body))
-           (handler-case (4 &rest (&whole 2 (&whole 4 &rest 1) &body)))
-	   (labels . flet)
-	   (macrolet . flet)
-	   ;; `else-body' style
-	   (if          (nil nil &body))
-	   ;; single-else style (then and else equally indented)
-	   (if          (&rest nil))
-	   ;; (lambda     ((&whole 4 &rest 1) &body))
-	   (lambda      ((&whole 4 &rest 1)
-			 &rest lisp-indent-function-lambda-hack))
-	   (let         ((&whole 4 &rest (&whole 1 1 2)) &body))
-	   (let* . let)
-	   (compiler-let . let) ;barf
-	   (locally 1)
-	   ;(loop ...)
-	   (multiple-value-bind 
-			((&whole 6 &rest 1) 4 &body))
-	   (multiple-value-call
-			(4 &body))
-	   (multiple-value-prog1 1)
-	   (multiple-value-setq
-			(4 2))
-	   (multiple-value-setf . multiple-value-setq)
-	   ;; Combines the worst features of BLOCK, LET and TAGBODY
-	   (prog        ((&whole 4 &rest 1) &rest lisp-indent-tagbody))
-	   (prog* . prog)
-	   (prog1 1)
-	   (prog2 2)
-	   (progn 0)
-	   (progv       (4 4 &body))
-	   (return 0)
-	   (return-from (nil &body))
-	   (tagbody     lisp-indent-tagbody)
-	   (throw 1)
-	   (unless 1)
-	   (unwind-protect (5 &body))
+           (case        (4 &rest (&whole 2 &rest 1)))
+           (ccase . case) (ecase . case)
+           (typecase . case) (etypecase . case) (ctypecase . 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)
+           (defcustom   (4 2 2 2))
+           (defparameter . defvar)
+           (defconst     . defcustom)
+           (define-condition  . defclass)
+           (define-modify-macro (4 &lambda &body))
+           (defsetf     (4 &lambda 4 &body))
+           (defun       (4 &lambda &body))
+           (define-setf-method . defun)
+           (define-setf-expander . defun)
+           (defmacro . defun) (defsubst . defun) (deftype . defun)
+	   (defmethod	lisp-indent-defmethod)
+           (defpackage  (4 2))
+           (defstruct   ((&whole 4 &rest (&whole 2 &rest 1))
+                         &rest (&whole 2 &rest 1)))
+           (destructuring-bind
+                        ((&whole 6 &rest 1) 4 &body))
+           (do          lisp-indent-do)
+           (do* . do)
+           (dolist      ((&whole 4 2 1) &body))
+           (dotimes . dolist)
+           (eval-when   1)
+           (flet        ((&whole 4 &rest (&whole 1 &lambda &body)) &body))
+           (labels . flet)
+           (macrolet . flet)
+           (generic-flet . flet) (generic-labels . flet)
+           (handler-case (4 &rest (&whole 2 &lambda &body)))
+           (restart-case . handler-case)
+           ;; `else-body' style
+           (if          (nil nil &body))
+           ;; single-else style (then and else equally indented)
+           (if          (&rest nil))
+           (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)
+           (locally 1)
+           ;(loop         lisp-indent-loop)
+           (:method (&lambda &body)) ; in `defgeneric'
+           (multiple-value-bind ((&whole 6 &rest 1) 4 &body))
+           (multiple-value-call (4 &body))
+           (multiple-value-prog1 1)
+           (multiple-value-setq (4 2))
+           (multiple-value-setf . multiple-value-setq)
+           (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)
+           (prog1 1)
+           (prog2 2)
+           (progn 0)
+           (progv       (4 4 &body))
+           (return 0)
+           (return-from (nil &body))
+           (symbol-macrolet . 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-output-to-string (4 2))
+           (with-slots . multiple-value-bind)
            (with-standard-io-syntax (2)))))
-  (while l
-    (put (car (car l)) 'common-lisp-indent-function
-	 (if (symbolp (cdr (car l)))
-	     (get (cdr (car l)) 'common-lisp-indent-function)
-	     (car (cdr (car l)))))
-    (setq l (cdr l))))
+  (dolist (el l)
+    (put (car el) 'common-lisp-indent-function
+         (if (symbolp (cdr el))
+             (get (cdr el) 'common-lisp-indent-function)
+             (car (cdr el))))))
 
 
 ;(defun foo (x)
@@ -475,7 +589,7 @@ by `lisp-body-indent'."
 ;             (t
 ;              (lose
 ;                3))))))
-          
+
 
 ;(put 'while    'common-lisp-indent-function 1)
 ;(put 'defwrapper'common-lisp-indent-function ...)
@@ -485,8 +599,11 @@ by `lisp-body-indent'."
 
 ;(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 ((* 1))) (3 4 ((* 1))) (4 &body)))
+;(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)
 
+;;; arch-tag: 7914d50f-92ec-4476-93fc-0f043a380e03
 ;;; cl-indent.el ends here