;; $Id: genind.el,v 1.10 1996/02/07 00:56:40 nickson Exp $

;; Generic, table-driven indentation

;; Copyright (C) 1991, 1994 by Ray Nickson <nickson@cs.uq.oz.au>
;; 
;; This program is free software; you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
;; the Free Software Foundation; either version 2 of the License, or
;; (at your option) any later version.
;; 
;; This program is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
;; GNU General Public License for more details.
;; 
;; You should have received a copy of the GNU General Public License
;; along with this program; if not, write to the Free Software
;; Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.

;; Author: Ray Nickson <nickson@cs.uq.oz.au>
;; With contributions from: Thomas Worsch <worsch@ira.uka.de>
;;                          Kayvan Sylvan <kayvan@satyr.Sylvan.COM>
;;
;; TO DO: indent-new-comment-line
;;        structure movement
;;        call function in VALUE
;;        combine current and previous into single ordered list
;;        rms suggests: write patten-match in C

(provide 'genind)

(defvar genind-previous-list nil
  "*List of (PATTERN . VALUE) pairs specifying indentation of a line based on
its predecessor.  See genind-calculate-indent (q.v.).")

(defvar genind-current-list nil
  "*List of (PATTERN . VALUE) pairs specifying indentation of a line based on
its own text.  See genind-calculate-indent (q.v.).")

(defvar genind-indent-triggers nil
  "*List of characters that trigger indentation when they are inserted.")

(defvar genind-indent-stretch 1
  "*Genind indentations are multiplied by this amount.  Buffer-local.")

(make-variable-buffer-local 'genind-previous-list)
(make-variable-buffer-local 'genind-current-list)
(make-variable-buffer-local 'genind-indent-triggers)
(make-variable-buffer-local 'genind-indent-stretch)

(defun genind-calculate-indent (line alist)
  "Return the indentation of the current line derived by comparing LINE
against ALIST.  ALIST is a list of (PATTERN . VALUE) pairs; the indentation
depends on the VALUE corresponding to the first-matched PATTERN and the local
value of genind-indent-stretch.  Leading and trailing whitespace is ignored for
the purpose of matching patterns.

  pattern                         matching function
  -------                         -----------------
  string                          treat string as regexp
  character with paren syntax     look for unmatched paren (l or r)
  atom                            call named function with line as arg
  (! pattern)                     pattern does not match
  (& pattern1 pattern2 ...)       all patterns match
  (| pattern1 pattern2 ...)       any pattern matches
  
  value     indentation
  -----     -----------
  n         n
  (+ n)     indentation of previous line + n
  (open n)  indentation of innermost enclosing open paren + n
  (match n) indentation of lparen matching last rparen + n
  (start n) indentation of line containing lparen matching last rparen + n
  (match redo n) means prepend the line with a matching lparen to this one
               and recalculate, then add n
  (upto n)  as far as the first character of the last match + n
  (past n)  as far as the first character after the last match + n"

  (let* ((val (genind-pattern-alist-match line alist))
         (tag (car-safe val))
         (num (car-safe (cdr-safe val)))
         (str genind-indent-stretch))
    (cond ((null val)
           nil)
          ((numberp val)
           (* val str))
          ((eq tag '+)
           (+ (genind-previous-indent) (* num str)))
          ((eq tag 'past)    ; past and upto by worsch%ira.uka.de 
           (+ (genind-previous-indent) (match-end 0) (* num str)))
          ((eq tag 'upto)
           (+ (genind-previous-indent) (match-beginning 0) (* num str)))
          ((and (eq tag 'match)
                (eq num 'redo))
           ;; treat all between match and here as one line and recalc
           (let* ((pt (point))
                  (start (progn (genind-backward-to-match) (point)))
                  (prefix (buffer-substring (progn (beginning-of-line nil)
                                                   (point))
                                            start))
                  (text (buffer-substring start pt))
                  (rtext (genind-replace-char-in-string text ?\n ? )))
             ;; we physically replace the text in the buffer by what we are
             ;; pretending it is.  What a hack!
             (goto-char pt)
             (delete-region start (point))
             (insert rtext "\n")
             (prog1
                 (genind-calculate-indent (concat prefix rtext) alist)
               (delete-region start (point))
               (insert text))))
          ((memq tag '(open match restart))
           (+ (genind-block-indent tag) num))
          (t (error "genind: bad value %s in pattern alist" val)))))

(defun genind-pattern-alist-match (text alist)
  (let ((start 0) (end (1- (length text))))
    (while (and (<= start end) (= (char-syntax (aref text start)) ? ))
      (setq start (1+ start)))
    (while (and (<= start end) (= (char-syntax (aref text end)) ? ))
      (setq end (1- end)))
    (genind-pattern-alist-match-int (substring text start (1+ end)) alist)))

(defun genind-pattern-alist-match-int (text alist)
  (cond ((null alist)
         nil)
        ((genind-pattern-match text (car (car alist)))
         (cdr (car alist)))
        (t
         (genind-pattern-alist-match-int text (cdr alist)))))

(defun genind-pattern-match (text pat)
  (cond ((stringp pat) (string-match pat text))
        ((characterp pat) (genind-unmatched-paren-in-string text pat))
        ((atom pat) (funcall pat text))
        ((eq (car-safe pat) '!) (not (genind-pattern-match text (cdr pat))))
        ((eq (car-safe pat) '&)
         (eval (cons 'and
                     (mapcar (function (lambda (p)
                                         (list 'genind-pattern-match text p)))
                             (cdr pat)))))
        ((eq (car-safe pat) '|)
         (eval (cons 'or
                     (mapcar (function (lambda (p)
                                         (genind-pattern-match text p)))
                             (cdr pat)))))
        (t (error "bad pattern"))))

(defun genind-unmatched-paren-in-string (str char)
  "Non-nil if there is an unmatched CHAR (a character with lparen syntax)
in STR."
  (let ((count 0)
        (odd 0)
        (even 0)
        (match (or (matching-paren char)
                   (error "%c does not have lparen syntax" char)))
        c)
    (while (< count (length str))
      (setq c (aref str count))
      (if (= c char) (setq even (1+ even)))
      (if (= c match) (setq odd (1+ odd)))
      (setq count (1+ count)))
    (> even odd)))

(defun genind-previous-line ()
  (if (bobp) ""
    (forward-line -1)
    (buffer-substring (point) (progn (end-of-line nil) (point)))))

(defun genind-previous-indent ()
  (save-excursion
    (forward-to-indentation -1)
    (current-column)))

(defun genind-block-indent (type)
  "TYPE is open, match or start."
  (save-excursion
    (condition-case junk
        (progn
          (cond ((eq type 'open)
                 (up-list -1))
                ((eq type 'match)
                 (genind-backward-to-match))
                ((eq type 'start)
                 (genind-backward-to-match)
                 (forward-to-indentation 0)))
          (current-column))
      (error 0))))

(defun genind-backward-to-match ()
  "Move backward to the open matching the last close before point."
  ;; find the close: assuming there is one!
  (backward-char 1)
  (while (/= (char-syntax (char-after (point))) ?\))
    (backward-char 1))
  (forward-char 1)
  (backward-sexp 1))

(defun genind-indent-line ()
  "Indent the current line based on the variables
genind-previous-list and genind-current-list."
  (interactive)
  (let (curind curlin prevlin ind (saved-point (- (point-max) (point))))
    (if (< (point) (progn (forward-to-indentation 0) (point)))
        (setq saved-point (- (point-max) (point))))
    (beginning-of-line nil)
    (save-excursion
      (setq curind (save-excursion
                     (forward-to-indentation 0)
                     (current-column)))
      (setq curlin (buffer-substring (point)
                                     (save-excursion
                                       (end-of-line nil)
                                       (point))))
      (setq prevlin (genind-previous-line)))
    (setq ind (or (genind-calculate-indent curlin
                                                 genind-current-list)
                        (genind-calculate-indent prevlin
                                                 genind-previous-list)
                        0))
    (cond ((< ind curind)
           (forward-to-indentation 0)
           (backward-delete-char-untabify (- curind ind)))
          ((> ind curind)
           (insert-char 32 (- ind curind))))
    (goto-char (- (point-max) saved-point))))

(defun genind-insert-indent ()
  "Self insert then trigger indentation, if this is one of
the genind-indent-triggers."
  (interactive)
  (let ((ch last-command-char))
    (insert-char ch 1)
    (if (= (char-syntax ch) ?\)) (blink-matching-open))
    (if (memq ch genind-indent-triggers) (genind-indent-line))))

(defun genind-bindings ()
  (local-set-key "\t" 'genind-indent-line)
  (make-local-variable 'indent-line-function)
  (setq indent-line-function 'genind-indent-line)
  (local-set-key "\C-M" 'newline-and-indent)
  (local-set-key "\C-J" 'newline)
  (mapcar '(lambda (key)
             (local-set-key (char-to-string key) 'genind-insert-indent))
          genind-indent-triggers))

(defun genind-replace-char-in-string (str char rep)
  "Return the string resulting from STRING by replacing all occurrences of
CHAR by REP."
  (setq str (copy-sequence str))
  (let ((c 0))
    (while (< c (length str))
      (if (= (aref str c) char)
          (aset str c rep))
      (setq c (1+ c))))
  str)
