Re: The indentation of lisp in linear time

[A Soare <alinsoar@voila.fr>]

[-- Attachment #1: Type: text/plain, Size: 447 bytes --]

I try again.

This time you have nothing to do... just to load this library and the new indentation will be installed.

I mean just the indentation for a line and for a region.

Maybe with this code I will be able to communicate with somebody from here.

Thanks in advance,



Alin Soare.



____________________________________________________

Sur le mail Voila, vous pouvez personnaliser l’anti-spam ! http://mail.voila.fr

[-- Attachment #2: indent.el --]
[-- Type: application/octet-stream, Size: 8025 bytes --]


(defun lisp-indent-value ()
  "
  VERSION : NEW
  "
  (cond ((elt state 3)
         ;; Inside a string, don't change indentation.
         nil
         )
        ((null (cadr state))
         ;; outside an expression align to the left column
         0
         )
        ((null indent)
         ;; an empty parethesis
         (1+ start-col))
        ((and (integerp lisp-indent-offset)
              (integerp (cadr indent)))
         ;; indent by constant offset
         (+ (cadr indent) lisp-indent-offset)
         )
        ((looking-at "\\s<\\s<\\s<")
         ;; Comments that start with three semicolons or more, should
         ;; start at the left margin
         0
         )
        ((eq (car indent) :l)
         ;; indent beneath a list
         (caddr indent)
         )
         ((and (eq (car indent) :w)
              (stringp (cadr indent))
              (>= (length (cadr indent)) 3)
              (string-equal "def" (substring (cadr indent) 0 3)))
         ;; indent a def-form
         (+ lisp-body-indent start-col)
         )
        ((and (eq (car indent) :w)
              (wholenump (get (intern-soft (cadr indent)) 'lisp-indent-function)))
         ;; here there is a special form
         (setq oo (or (get (intern-soft (cadr indent)) 'lisp-indent-function)
                      (get (intern-soft (cadr indent)) 'lisp-indent-hook)))
         (if (> (length indent) (* 3 oo))
             (+ lisp-body-indent start-col)
           (+ (* 2 lisp-body-indent) start-col))
         )
        ((and (eq (car indent) :w)
              (get (intern-soft (cadr indent)) 'lisp-indent-hook)
              nil)
         ;; indent defined by another function
         ;; not defined yet
         (funcall (get (intern-soft (cadr indent)) 'lisp-indent-hook))
         )
        ((and (equal (following-char) ?:)
              nil)
         ;; indent of a constant symbol
         ;; not yed defined
         (caddr indent)
         )
        ((and (eq (car indent) :w)
              (> (length indent) 3))
         ;; indent beneath the `indent-what-argument' parameter
         (elt indent (+ 3 (1- (* 3 indent-what-argument))))
         )
        (t
         ;;  the first parameter of a function call
         (caddr indent))
         ))

(defun lisp-indent-what-argument nil
  (cond ((and (eq (car indent) :w)
              (stringp (cadr indent))
              (>= (length (cadr indent)) 3)
              (string-equal "def" (substring (cadr indent) 0 3))
              (= (length indent) 9))
         ;; if the second parameter of defun is a list, then this list
         ;; is not a function call
         0)
        ((or
          (and (>= (length indent) 6)
               (eq (elt indent (- (length indent ) 6)) :q))
          (and (eq (car indent) :w)
               (stringp (cadr indent))
               (string-equal "quote" (cadr indent))))
         ;; a quoted list is not a function call
         0
         )
        (t
         ;; for the rest, always indent beneath the first parameter of
         ;; the function...
         1)))

(defun lisp-indent-next-state (&optional n)
  (setq steps (or n 1)
        state (parse-partial-sexp (point) (+ steps (point)) () () state)
        column (+ steps column)))

(defun lisp-indent-automaton (&optional indent-what-argument start-col indent)
  "
   an automaton to indent the lisp code
   VERSION: NEW
  "
  (or indent-what-argument
      (setq indent-what-argument 0))
  (or state (and (beginning-of-defun)
                 (setq column (current-column))))
  (and (null start-col) (setq start-col 0))
  (catch 'STOP
    (while (< (point) end)
      (cond ((and (elt state 8)
                  (not (elt state 4)))
             ;; inside a string
             (and (looking-at "\\s>")
                  (setq indent-lines (cons (lisp-indent-value) indent-lines)
                        column 0))
             (lisp-indent-next-state)
             )
            ((looking-at "\\s\"")
             ;; the start of a string
             (setq indent (append indent (list :s () column)))
             (lisp-indent-next-state)
             )
            ((looking-at "\\s\(")
             ;; open a parenthesis
             (let ((col (if indent-lines
                            (+ column (- (caar indent-lines) (cdar indent-lines)))
                          column)))
               (setq indent (append indent (list :l () col)))
               (lisp-indent-next-state)
               (lisp-indent-automaton (lisp-indent-what-argument) col))
             )
            ((looking-at "\\s\)")
             ;; close a parenthesis
             (lisp-indent-next-state)
             (throw 'STOP nil)
             )
            ((looking-at "\\s ")
             ;; spaces are ignored
             (while (looking-at "[[:blank:]]")
               (lisp-indent-next-state))
             )
            ((looking-at "\\sw\\|\\s_")
             ;; a function or a parameter
             (let* ((col (if indent-lines
                            (+ column (- (caar indent-lines) (cdar indent-lines)))
                          column))
                    r
                    (w (catch 'WORD
                         (while t
                           (setq r (concat r (string (following-char))))
                           (lisp-indent-next-state)
                           (and (not (looking-at "\\w\\|\\s_"))
                                (throw 'WORD r))))))
               (setq indent (append indent (list :w w col))))
             )
            ((looking-at "\\s<")
             ;; start of a comment
             (while (not (looking-at "\\s>"))
               (lisp-indent-next-state))
             )
            ((looking-at "\\s\'")
             ;; quote
             (setq indent (append indent (list :q () column)))
             (lisp-indent-next-state)
             )
            ((looking-at "\\s\\")
             ;; a special character
             (lisp-indent-next-state 2)
             )
            ((looking-at "\\s>")
             ;; end of line
             (lisp-indent-next-state)
             (setq column 0)
             (while (looking-at "\\s ")
               (lisp-indent-next-state))
             (setq indent-lines (cons (cons (lisp-indent-value) column) indent-lines))
             )
            (t
             (error "oops! unknown class of syntax ! (indent failed at position %d)" (point)))))))

(defun indent-region (beg end)
  "
  An example how to use the automatonin for indentig a whole region
  of lisp code in linear time (a function from the beginning to the point).
  "
  (let* (indent-lines
         state 
         l)
    (save-excursion
      (goto-char beg)
      (lisp-indent-automaton)
      (let ((j indent-lines)
            i)
        (while (> (point) beg)
          (setq i (car j))
          (when (consp i)
            (setq l (prog2 (beginning-of-line) (point)))
            (skip-chars-forward "[[:blank:]]")
            (when (not (zerop (-  (- l (point)) (- (cdr i) (car i)))))
              (delete-region l (point))
              (indent-to (car i))))
          (previous-line)
          (setq j (cdr j)))))))
    
(defun indent-line nil
  "
  An example how to indent a line of code using the automaton
  "
  (let* (indent-lines
         state 
         dif
         (pos (point-marker))
         (end (prog2 (beginning-of-line) (point))))
    (or end (beginning-of-line) (setq end (point)))
    (save-excursion (lisp-indent-automaton))
    (if (not (consp (car indent-lines)))
        nil
      (setq dif
            (or (catch 'DIF
                  (dolist (i (cdr indent-lines))
                    (and (consp i)
                         (throw 'DIF (- (cdr i) (car i))))))
                0))
      (skip-chars-forward "[[:blank:]]")
      (when (not (zerop (- (+ (caar indent-lines) dif) (- (point) end))))
        (delete-region end (point))
        (indent-to (+ (caar indent-lines) dif))))
    (goto-char (max pos (point)))))

(fset indent-line-function 'indent-line)