;;; n.el --- N code editing commands for Emacs
;;; adapted from OCaml 2.04 emacs/caml.el

;; Kwangkeun Yi, Feb 2000

;;indentation code is Copyright (C) 1996 by Ian T Zimmerman <itz@rahul.net>
;;copying: covered by the current FSF General Public License.

;; indentation code adapted for Objective Caml by Jacques Garrigue,
;; july 1997. <garrigue@kurims.kyoto-u.ac.jp>

;;user customizable variables
(defvar n-quote-char "'"
  "*Quote for character constants. \"'\" for N, \"`\" for N.")

(defvar n-imenu-enable nil
  "*Enable Imenu support.")

(defvar n-olabl-disable nil
  "*Disable O'Labl support")

(defvar n-mode-indentation 2
  "*Used for \\[n-unindent-command].")

(defvar n-lookback-limit 5000
  "*How far to look back for syntax things in n mode.")

(defvar n-max-indent-priority 8
  "*Bounds priority of operators permitted to affect n indentation.

Priorities are assigned to `interesting' n operators as follows:

	all keywords 0 to 7	8
	type, val, ... + 0	7
	:: ^			6
	@			5
	:= <-			4
	if			3
	fun, let, match ...	2
	module			1
	opening keywords 	0.")

(defvar n-apply-extra-indent 2
  "*How many spaces to add to indentation for an application in n mode.")
(make-variable-buffer-local 'n-apply-extra-indent)

(defvar n-begin-indent 2
  "*How many spaces to indent from a begin keyword in n mode.")
(make-variable-buffer-local 'n-begin-indent)

(defvar n-class-indent 2
  "*How many spaces to indent from a class keyword in n mode.")
(make-variable-buffer-local 'n-class-indent)

(defvar n-exception-indent 2
  "*How many spaces to indent from a exception keyword in n mode.")
(make-variable-buffer-local 'n-exception-indent)

(defvar n-for-indent	2
  "*How many spaces to indent from a for keyword in n mode.")
(make-variable-buffer-local 'n-for-indent)

(defvar n-fun-indent	2
  "*How many spaces to indent from a fun keyword in n mode.")
(make-variable-buffer-local 'n-fun-indent)

(defvar n-function-indent 4
  "*How many spaces to indent from a function keyword in n mode.")
(make-variable-buffer-local 'n-function-indent)

(defvar n-if-indent	2
  "*How many spaces to indent from a if keyword in n mode.")
(make-variable-buffer-local 'n-if-indent)

(defvar n-if-else-indent 0
  "*How many spaces to indent from an if .. else line in n mode.")
(make-variable-buffer-local 'n-if-else-indent)

(defvar n-inherit-indent 2
  "*How many spaces to indent from a inherit keyword in n mode.")
(make-variable-buffer-local 'n-inherit-indent)

(defvar n-initializer-indent 2
  "*How many spaces to indent from a initializer keyword in n mode.")
(make-variable-buffer-local 'n-initializer-indent)

(defvar n-include-indent 2
  "*How many spaces to indent from a include keyword in n mode.")
(make-variable-buffer-local 'n-include-indent)

(defvar n-let-indent	2
  "*How many spaces to indent from a let keyword in n mode.")
(make-variable-buffer-local 'n-let-indent)

(defvar n-let-in-indent 0
  "*How many spaces to indent from a let .. in keyword in n mode.")
(make-variable-buffer-local 'n-let-in-indent)

(defvar n-match-indent 2
  "*How many spaces to indent from a match keyword in n mode.")
(make-variable-buffer-local 'n-match-indent)

(defvar n-method-indent 2
  "*How many spaces to indent from a method keyword in n mode.")
(make-variable-buffer-local 'n-method-indent)

(defvar n-module-indent 2
  "*How many spaces to indent from a module keyword in n mode.")
(make-variable-buffer-local 'n-module-indent)

(defvar n-object-indent 2
  "*How many spaces to indent from a object keyword in n mode.")
(make-variable-buffer-local 'n-object-indent)

(defvar n-of-indent 2
  "*How many spaces to indent from a of keyword in n mode.")
(make-variable-buffer-local 'n-of-indent)

(defvar n-parser-indent 4
  "*How many spaces to indent from a parser keyword in n mode.")
(make-variable-buffer-local 'n-parser-indent)

(defvar n-sig-indent 2
  "*How many spaces to indent from a sig keyword in n mode.")
(make-variable-buffer-local 'n-sig-indent)

(defvar n-struct-indent 2
  "*How many spaces to indent from a struct keyword in n mode.")
(make-variable-buffer-local 'n-struct-indent)

(defvar n-try-indent	2
  "*How many spaces to indent from a try keyword in n mode.")
(make-variable-buffer-local 'n-try-indent)

(defvar n-type-indent 4
  "*How many spaces to indent from a type keyword in n mode.")
(make-variable-buffer-local 'n-type-indent)

(defvar n-val-indent	2
  "*How many spaces to indent from a val keyword in n mode.")
(make-variable-buffer-local 'n-val-indent)

(defvar n-while-indent 2
  "*How many spaces to indent from a while keyword in n mode.")
(make-variable-buffer-local 'n-while-indent)

(defvar n-::-indent	2
  "*How many spaces to indent from a :: operator in n mode.")
(make-variable-buffer-local 'n-::-indent)

(defvar n-@-indent	2
  "*How many spaces to indent from a @ operator in n mode.")
(make-variable-buffer-local 'n-@-indent)

(defvar n-:=-indent  2
  "*How many spaces to indent from a := operator in n mode.")
(make-variable-buffer-local 'n-:=-indent)

(defvar n-<--indent	2
  "*How many spaces to indent from a <- operator in n mode.")
(make-variable-buffer-local 'n-<--indent)

(defvar n-->-indent	2
  "*How many spaces to indent from a -> operator in n mode.")
(make-variable-buffer-local 'n-->-indent)

(defvar n-lb-indent 2
  "*How many spaces to indent from a \[ operator in n mode.")
(make-variable-buffer-local 'n-lb-indent)

(defvar n-lc-indent 2
  "*How many spaces to indent from a \{ operator in n mode.")
(make-variable-buffer-local 'n-lc-indent)

(defvar n-lp-indent	1
  "*How many spaces to indent from a \( operator in n mode.")
(make-variable-buffer-local 'n-lp-indent)

(defvar n-and-extra-indent nil
  "*Extra indent for n lines starting with the and keyword.
Usually negative. nil is align on master.")
(make-variable-buffer-local 'n-and-extra-indent)

(defvar n-do-extra-indent nil
  "*Extra indent for n lines starting with the do keyword.
Usually negative. nil is align on master.")
(make-variable-buffer-local 'n-do-extra-indent)

(defvar n-done-extra-indent nil
  "*Extra indent for n lines starting with the done keyword.
Usually negative. nil is align on master.")
(make-variable-buffer-local 'n-done-extra-indent)

(defvar n-else-extra-indent nil
  "*Extra indent for n lines starting with the else keyword.
Usually negative. nil is align on master.")
(make-variable-buffer-local 'n-else-extra-indent)

(defvar n-end-extra-indent nil
  "*Extra indent for n lines starting with the end keyword.
Usually negative. nil is align on master.")
(make-variable-buffer-local 'n-end-extra-indent)

(defvar n-in-extra-indent nil
  "*Extra indent for n lines starting with the in keyword.
Usually negative. nil is align on master.")
(make-variable-buffer-local 'n-in-extra-indent)

(defvar n-then-extra-indent nil
  "*Extra indent for n lines starting with the then keyword.
Usually negative. nil is align on master.")
(make-variable-buffer-local 'n-then-extra-indent)

(defvar n-to-extra-indent -1
  "*Extra indent for n lines starting with the to keyword.
Usually negative. nil is align on master.")
(make-variable-buffer-local 'n-to-extra-indent)

(defvar n-with-extra-indent nil
  "*Extra indent for n lines starting with the with keyword.
Usually negative. nil is align on master.")
(make-variable-buffer-local 'n-with-extra-indent)

(defvar n-comment-indent 3
  "*Indent inside comments.")
(make-variable-buffer-local 'n-comment-indent)

(defvar n-|-extra-indent -2
  "*Extra indent for n lines starting with the | operator.
Usually negative. nil is align on master.")
(make-variable-buffer-local 'n-|-extra-indent)

(defvar n-rb-extra-indent -2
  "*Extra indent for n lines statring with ].
Usually negative. nil is align on master.")

(defvar n-rc-extra-indent -2
  "*Extra indent for n lines starting with }.
Usually negative. nil is align on master.")

(defvar n-rp-extra-indent -1
  "*Extra indent for n lines starting with ).
Usually negative. nil is align on master.")

(defvar n-electric-indent t
  "*Non-nil means electrically indent lines starting with |, ] or }.

Many people find eletric keys irritating, so you can disable them if
you are one.")

(defvar n-electric-close-vector t
  "*Non-nil means electrically insert a | before a vector-closing ].

Many people find eletric keys irritating, so you can disable them if
you are one. You should probably have this on, though, if you also
have n-electric-indent on, which see.")

;;code
(if (or (not (fboundp 'indent-line-to))
	(not (fboundp 'buffer-substring-no-properties)))
    (require 'n-compat))

(defvar n-shell-active nil
  "*Non nil when a subshell is running.")

;; is it really ok ? Conform to Xemacs definition
(if (not (boundp 'running-xemacs)) (setq running-xemacs nil))

(defvar n-mode-map nil
  "Keymap used in Caml mode.")
(if n-mode-map
    ()
  (setq n-mode-map (make-sparse-keymap))
  (define-key n-mode-map "|" 'n-electric-pipe)
  (define-key n-mode-map "}" 'n-electric-pipe)
  (define-key n-mode-map "]" 'n-electric-rb)
  (define-key n-mode-map "\t" 'n-indent-command)
  (define-key n-mode-map [backtab] 'n-unindent-command)

;itz 04-21-96 instead of defining a new function, use defadvice
;that way we get out effect even when we do \C-x` in compilation buffer  
;  (define-key n-mode-map "\C-x`" 'n-next-error)

  (define-key n-mode-map "\177" 'backward-delete-char-untabify)
  (define-key n-mode-map "\C-cb" 'n-insert-begin-form)
  (define-key n-mode-map "\C-cf" 'n-insert-for-form)
  (define-key n-mode-map "\C-ci" 'n-insert-if-form)
  (define-key n-mode-map "\C-cl" 'n-insert-let-form)
  (define-key n-mode-map "\C-cm" 'n-insert-match-form)
  (define-key n-mode-map "\C-ct" 'n-insert-try-form)
  (define-key n-mode-map "\C-cw" 'n-insert-while-form)
  (define-key n-mode-map "\C-c`" 'n-goto-phrase-error)
  (define-key n-mode-map "\C-c\C-a" 'n-find-alternate-file)
  (define-key n-mode-map "\C-c\C-c" 'compile)
  (define-key n-mode-map "\C-c\C-e" 'n-eval-phrase)
  (define-key n-mode-map "\C-c\C-\[" 'n-backward-to-less-indent)
  (define-key n-mode-map "\C-c\C-\]" 'n-forward-to-less-indent)
  (define-key n-mode-map "\C-c\C-q" 'n-indent-phrase)
  (define-key n-mode-map "\C-c\C-r" 'n-eval-region)
  (define-key n-mode-map "\C-c\C-s" 'n-show-subshell)
  (define-key n-mode-map "\M-\C-h" 'n-mark-phrase)
  (define-key n-mode-map "\M-\C-q" 'n-indent-phrase)
  (define-key n-mode-map "\M-\C-x" 'n-eval-phrase)
  (if running-xemacs nil ; if not running xemacs
    (let ((map (make-sparse-keymap "Caml"))
	  (forms (make-sparse-keymap "Forms")))
      (define-key n-mode-map "\C-c\C-d" 'n-show-imenu)
      (define-key n-mode-map [menu-bar] (make-sparse-keymap))
      (define-key n-mode-map [menu-bar n] (cons "Caml" map))
      (define-key map [run-n] '("Start subshell..." . run-n))
      (define-key map [compile] '("Compile..." . compile))
      (define-key map [switch-view]
	'("Switch view" . n-find-alternate-file))
      (define-key map [separator-format] '("--"))
      (define-key map [forms] (cons "Forms" forms))
      (define-key map [show-imenu] '("Show index" . n-show-imenu))
      (put 'n-show-imenu 'menu-enable '(not n-imenu-shown))
      (define-key map [show-subshell] '("Show subshell" . n-show-subshell))
      (put 'n-show-subshell 'menu-enable 'n-shell-active)
      (define-key map [eval-phrase] '("Eval phrase" . n-eval-phrase))
      (put 'n-eval-phrase 'menu-enable 'n-shell-active)
      (define-key map [indent-phrase] '("Indent phrase" . n-indent-phrase))
      (define-key forms [while]
	'("while .. do .. done" . n-insert-while-form))
      (define-key forms [try] '("try .. with .." . n-insert-try-form))
      (define-key forms [match] '("match .. with .." . n-insert-match-form))
      (define-key forms [let] '("let .. in .." . n-insert-let-form))
      (define-key forms [if] '("if .. then .. else .." . n-insert-if-form))
      (define-key forms [begin] '("for .. do .. done" . n-insert-for-form))
      (define-key forms [begin] '("begin .. end" . n-insert-begin-form)))))

(defvar n-mode-xemacs-menu
  (if running-xemacs
      '("Caml"
	[ "Indent phrase" n-indent-phrase :keys "C-M-q" ]
	[ "Eval phrase" n-eval-phrase
	  :active n-shell-active :keys "C-M-x" ]
	[ "Show subshell" n-show-subshell n-shell-active ]
	("Forms"
	 [ "while .. do .. done" n-insert-while-form t]
	 [ "try .. with .." n-insert-try-form t ]
	 [ "match .. with .." n-insert-match-form t ]
	 [ "let .. in .." n-insert-let-form t ]
	 [ "if .. then .. else .." n-insert-if-form t ]
	 [ "for .. do .. done" n-insert-for-form t ]
	 [ "begin .. end" n-insert-begin-form t ])
	"---"
	[ "Switch view" n-find-alternate-file t ]
	[ "Compile..." compile t ]
	[ "Start subshell..." run-n t ]))
  "Menu to add to the menubar when running Xemacs")

(defvar n-mode-syntax-table nil
  "Syntax table in use in Caml mode buffers.")
(if n-mode-syntax-table
    ()
  (setq n-mode-syntax-table (make-syntax-table))
  ; backslash is an escape sequence
  (modify-syntax-entry ?\\ "\\" n-mode-syntax-table)
  ; ( is first character of comment start
  (modify-syntax-entry ?\( "()1" n-mode-syntax-table)
  ; * is second character of comment start,
  ; and first character of comment end
  (modify-syntax-entry ?*  ". 23" n-mode-syntax-table)
  ; ) is last character of comment end
  (modify-syntax-entry ?\) ")(4" n-mode-syntax-table)
  ; backquote was a string-like delimiter (for character literals)
  ; (modify-syntax-entry ?` "\"" n-mode-syntax-table)
  ; quote and underscore are part of words
  (modify-syntax-entry ?' "w" n-mode-syntax-table)
  (modify-syntax-entry ?_ "w" n-mode-syntax-table)
  ; : is part of words (labels) in O'Labl
  (if n-olabl-disable nil 
    (modify-syntax-entry ?: "w" n-mode-syntax-table))
  ; ISO-latin accented letters and EUC kanjis are part of words
  (let ((i 160))
    (while (< i 256)
      (modify-syntax-entry i "w" n-mode-syntax-table)
      (setq i (1+ i)))))

(defvar n-mode-abbrev-table nil
  "Abbrev table used for Caml mode buffers.")
(if n-mode-abbrev-table nil
  (setq n-mode-abbrev-table (make-abbrev-table))
  (define-abbrev n-mode-abbrev-table "and" "and" 'n-abbrev-hook)
  (define-abbrev n-mode-abbrev-table "do" "do" 'n-abbrev-hook)
  (define-abbrev n-mode-abbrev-table "done" "done" 'n-abbrev-hook)
  (define-abbrev n-mode-abbrev-table "else" "else" 'n-abbrev-hook)
  (define-abbrev n-mode-abbrev-table "end" "end" 'n-abbrev-hook)
  (define-abbrev n-mode-abbrev-table "in" "in" 'n-abbrev-hook)
  (define-abbrev n-mode-abbrev-table "then" "then" 'n-abbrev-hook)
  (define-abbrev n-mode-abbrev-table "with" "with" 'n-abbrev-hook))

;;; The major mode
(eval-when-compile
  (if (and (boundp 'running-xemacs) running-xemacs) nil
    (require 'imenu)))

(defun n-mode ()
  "Major mode for editing Caml code.

\\{n-mode-map}"

  (interactive)
  (kill-all-local-variables)
  (setq major-mode 'n-mode)
  (setq mode-name "n")
  (use-local-map n-mode-map)
  (set-syntax-table n-mode-syntax-table)
  (setq local-abbrev-table n-mode-abbrev-table)
  (make-local-variable 'paragraph-start)
  (setq paragraph-start (concat "^$\\|" page-delimiter))
  (make-local-variable 'paragraph-separate)
  (setq paragraph-separate paragraph-start)
  (make-local-variable 'paragraph-ignore-fill-prefix)
  (setq paragraph-ignore-fill-prefix t)
  (make-local-variable 'require-final-newline)
  (setq require-final-newline t)
  (make-local-variable 'comment-start)
  (setq comment-start "(*")
  (make-local-variable 'comment-end)
  (setq comment-end "*)")
  (make-local-variable 'comment-column)
  (setq comment-column 40)
  (make-local-variable 'comment-start-skip)
  (setq comment-start-skip "(\\*+ *")
  (make-local-variable 'parse-sexp-ignore-comments)
  (setq parse-sexp-ignore-comments nil)
  (make-local-variable 'indent-line-function)
  (setq indent-line-function 'n-indent-command)
  ;itz Fri Sep 25 13:23:49 PDT 1998
  (make-local-variable 'add-log-current-defun-function)
  (setq add-log-current-defun-function 'n-current-defun)
  ;itz 03-25-96
  (setq before-change-function 'n-before-change-function)
  (setq n-last-noncomment-pos nil)
  (setq n-last-comment-start (make-marker))
  (setq n-last-comment-end (make-marker))
  ;garrigue 27-11-96
  (setq case-fold-search nil)
  ;garrigue july 97
  (if running-xemacs ; from Xemacs lisp mode
      (if (and (featurep 'menubar)
	       current-menubar)
	  (progn
	    ;; make a local copy of the menubar, so our modes don't
	    ;; change the global menubar
	    (set-buffer-menubar current-menubar)
	    (add-submenu nil n-mode-xemacs-menu)))
    ;imenu support (not for Xemacs)
    (make-local-variable 'imenu-create-index-function)
    (setq imenu-create-index-function 'n-create-index-function)
    (make-local-variable 'imenu-generic-expression)
    (setq imenu-generic-expression n-imenu-search-regexp)
    (make-local-variable 'n-imenu-shown)
    (setq n-imenu-shown nil)
    (if (and n-imenu-enable (< (buffer-size) 10000))
	(n-show-imenu)))
  ;; Kwang 2/8/00
  ;(require 'n-font)
  ;; Kwang end
  (run-hooks 'n-mode-hook))

;;; Auxiliary function. Garrigue 96-11-01.

(defun n-find-alternate-file ()
  (interactive)
  (let ((name (buffer-file-name)))
    (if (string-match "^\\(.*\\)\\.\\(ml\\|mli\\)$" name)
	(find-file
	 (concat
	  (n-match-string 1 name)
	  (if (string= "ml" (n-match-string 2 name)) ".mli" ".ml"))))))

;;; subshell support

(defun n-eval-region (start end)
  "Send the current region to the inferior Caml process."
  (interactive"r")
  (inferior-n-eval-region start end))

(defun n-eval-phrase ()
  "Send the current Caml phrase to the inferior Caml process."
  (interactive)
  (save-excursion
    (let ((bounds (n-mark-phrase)))
    (inferior-n-eval-region (car bounds) (cdr bounds)))))

(defun n-show-subshell ()
  (interactive)
  (inferior-n-show-subshell))

;;; Imenu support
(defun n-show-imenu ()
  (interactive)
  (require 'imenu)
  (switch-to-buffer (current-buffer))
  (imenu-add-to-menubar "Defs")
  (setq n-imenu-shown t))

(defconst n-imenu-search-regexp
  (concat "\\<in\\>\\|"
	  "^[ \t]*\\(let\\|class\\|type\\|m\\(odule\\|ethod\\)"
	  "\\|functor\\|and\\|val\\)[ \t]+"
	  "\\(\\('[a-zA-Z0-9]+\\|([^)]+)"
	  "\\|mutable\\|private\\|rec\\|type\\)[ \t]+\\)?"
	  "\\([a-zA-Z][a-zA-Z0-9_']*\\)"))
(defun n-prev-index-position-function ()
  (let (found data)
    (while (and (setq found
		      (re-search-backward n-imenu-search-regexp nil 'move))
		(progn (setq data (match-data)) t)
		(or (n-in-literal-p)
		    (n-in-comment-p)
		    (if (looking-at "in") (n-find-in-match)))))
    (set-match-data data)
    found))
(defun n-create-index-function ()
  (let (value-alist
	type-alist
	class-alist
	method-alist
	module-alist
	and-alist
	all-alist
	menu-alist
	(prev-pos (point-max))
	index)
    (goto-char prev-pos)
    (imenu-progress-message prev-pos 0 t)
    ;; collect definitions
    (while (n-prev-index-position-function)
      (setq index (cons (n-match-string 5) (point)))
      (imenu-progress-message prev-pos nil t)
      (setq all-alist (cons index all-alist))
      (cond
       ((looking-at "[ \t]*and")
	(setq and-alist (cons index and-alist)))
       ((looking-at "[ \t]*let")
	(setq value-alist (cons index (append and-alist value-alist)))
	(setq and-alist nil))
       ((looking-at "[ \t]*type")
	(setq type-alist (cons index (append and-alist type-alist)))
	(setq and-alist nil))
       ((looking-at "[ \t]*class")
	(setq class-alist (cons index (append and-alist class-alist)))
	(setq and-alist nil))
       ((looking-at "[ \t]*val")
	(setq value-alist (cons index value-alist)))
       ((looking-at "[ \t]*\\(module\\|functor\\)")
	(setq module-alist (cons index module-alist)))
       ((looking-at "[ \t]*method")
	(setq method-alist (cons index method-alist)))))
    ;; build menu
    (mapcar
     '(lambda (pair)
	(if (symbol-value (cdr pair))
	    (setq menu-alist
		  (cons
		   (cons (car pair)
			 (sort (symbol-value (cdr pair)) 'imenu--sort-by-name))
		   menu-alist))))
     '(("Values" . value-alist)
       ("Types" . type-alist)
       ("Modules" . module-alist)
       ("Methods" . method-alist)
       ("Classes" . class-alist)))
    (if all-alist (setq menu-alist (cons (cons "Index" all-alist) menu-alist)))
    (imenu-progress-message prev-pos 100 t)
    menu-alist))

;;; Indentation stuff

(defun n-in-indentation ()
  "Tests whether all characters between beginning of line and point
are blanks."
  (save-excursion
    (skip-chars-backward " \t")
    (bolp)))

;;; The command
;;; Sorry, I didn't like the previous behaviour... Garrigue 96/11/01

(defun n-indent-command (&optional p)
  "Indent the current line in Caml mode.

Compute new indentation based on n syntax. If prefixed, indent
the line all the way to where point is."

  (interactive "*p")
  (cond
   ((and p (> p 1)) (indent-line-to (current-column)))
   ((n-in-indentation) (indent-line-to (n-compute-final-indent)))
   (t (save-excursion
	(indent-line-to
	 (n-compute-final-indent))))))
   
(defun n-unindent-command ()

  "Decrease indentation by one level in Caml mode.  

Works only if the point is at the beginning of an indented line
\(i.e. all characters between beginning of line and point are
blanks\).  Does nothing otherwise. The unindent size is given by the
variable n-mode-indentation."

  (interactive "*")
  (let* ((begline
          (save-excursion
            (beginning-of-line)
            (point)))
         (current-offset
          (- (point) begline)))
    (if (and (>= current-offset n-mode-indentation)
             (n-in-indentation))
        (backward-delete-char-untabify n-mode-indentation))))

;;;
;;; Error processing
;;;

;; Error positions are given in bytes, not in characters
;; This function switches to monobyte mode

(if (not (fboundp 'char-bytes))
    (defalias 'forward-byte 'forward-char)
  (defun n-char-bytes (ch)
    (let ((l (char-bytes ch)))
      (if (> l 1) (- l 1) l)))
  (defun forward-byte (count)
    (if (> count 0)
	(while (> count 0)
	  (setq count (- count (n-char-bytes (char-after))))
	  (forward-char))
      (while (< count 0)
	(setq count (+ count (n-char-bytes (char-before))))
	(backward-char)))))

(require 'compile)

;; In Emacs 19, the regexps in compilation-error-regexp-alist do not
;; match the error messages when the language is not English.
;; Hence we add a regexp.

(defconst n-error-regexp
  "^[A-\377]+ \"\\([^\"\n]+\\)\", [A-\377]+ \\([0-9]+\\)[-,:]"
  "Regular expression matching the error messages produced by nc.")

(if (boundp 'compilation-error-regexp-alist)
    (or (assoc n-error-regexp
               compilation-error-regexp-alist)
        (setq compilation-error-regexp-alist
              (cons (list n-error-regexp 1 2)
               compilation-error-regexp-alist))))

;; A regexp to extract the range info

(defconst n-error-chars-regexp
  ".*, .*, [A-\377]+ \\([0-9]+\\)-\\([0-9]+\\):"
  "Regular expression extracting the character numbers
from an error message produced by nc.")

;; Wrapper around next-error.

(defvar n-error-overlay nil)

;;itz 04-21-96 somebody didn't get the documetation for next-error
;;right. When the optional argument is a number n, it should move
;;forward n errors, not reparse.

;itz 04-21-96 instead of defining a new function, use defadvice
;that way we get our effect even when we do \C-x` in compilation buffer  

(defadvice next-error (after n-next-error activate)
 "Reads the extra positional information provided by the Caml compiler.

Puts the point and the mark exactly around the erroneous program
fragment. The erroneous fragment is also temporarily highlighted if
possible."

 (if (eq major-mode 'n-mode)
     (let (bol beg end)
       (save-excursion
	 (set-buffer
	  (if (boundp 'compilation-last-buffer) 
	      compilation-last-buffer	;Emacs 19
	    "*compilation*"))		;Emacs 18
	 (save-excursion
	   (goto-char (window-point (get-buffer-window (current-buffer))))
	   (if (looking-at n-error-chars-regexp)
	       (setq beg
		     (string-to-int
		      (buffer-substring (match-beginning 1) (match-end 1)))
		     end
		     (string-to-int
		      (buffer-substring (match-beginning 2) (match-end 2)))))))
       (cond (beg
	      (setq end (- end beg))
              (beginning-of-line)
	      (forward-byte beg)
	      (setq beg (point))
	      (forward-byte end)
	      (setq end (point))
	      (goto-char beg)
	      (push-mark end t)
	      (cond ((fboundp 'make-overlay)
		     (if n-error-overlay ()
		       (setq n-error-overlay (make-overlay 1 1))
		       (overlay-put n-error-overlay 'face 'region))
		     (unwind-protect
			 (progn
			   (move-overlay n-error-overlay
					 beg end (current-buffer))
			   (sit-for 60))
		       (delete-overlay n-error-overlay)))))))))

;; Usual match-string doesn't work properly with font-lock-mode
;; on some emacs.

(defun n-match-string (num &optional string)

  "Return string of text matched by last search, without properties.

NUM specifies which parenthesized expression in the last regexp.
Value is nil if NUMth pair didn't match, or there were less than NUM
pairs.  Zero means the entire text matched by the whole regexp or
whole string."

  (let* ((data (match-data))
	 (begin (nth (* 2 num) data))
	 (end (nth (1+ (* 2 num)) data)))
    (if string (substring string begin end)
      (buffer-substring-no-properties begin end))))

;; itz Thu Sep 24 19:02:42 PDT 1998 this is to have some level of
;; comfort when sending phrases to the toplevel and getting errors.
(defun n-goto-phrase-error ()
  "Find the error location in current Caml phrase."
  (interactive)
  (let ((bounds (save-excursion (n-mark-phrase))))
    (inferior-n-goto-error (car bounds) (cdr bounds))))

;;; Phrases

;itz the heuristics used to see if we're `between two phrases'
;didn't seem right to me.

(defconst n-phrase-start-keywords
  (concat "\\<\\(class\\|ex\\(ternal\\|ception\\)\\|functor"
	  "\\|let\\|module\\|open\\|type\\|val\\)\\>")
  "Keywords starting phrases in files")

;; a phrase starts when a toplevel keyword is at the beginning of a line
(defun n-at-phrase-start-p ()
  (and (bolp)
       (or (looking-at "#")
	   (looking-at n-phrase-start-keywords))))

(defun n-mark-phrase ()
  "Put mark at end of this N phrase, point at beginning.

The N phrase is the phrase just before the point.
Adapted from J. Garrigue version for Objective Caml and Caml-Light."

  (interactive)
  (let (use-semi end)
    (if (and (looking-at ";") (not (n-in-comment-p))) nil
      (if (n-at-phrase-start-p) (forward-char))
      (while (and (cond
		   ((re-search-forward
		     (concat ";\\|" n-phrase-start-keywords) nil 'move)
		    (goto-char (match-beginning 0)) t))
		  (or (not (or (bolp) (looking-at ";")))
		      (n-in-comment-p)
		      (n-in-literal-p)))
	(forward-char)))
    (setq use-semi (looking-at ";"))
    (skip-chars-backward " \n\t")
    (while (and (eq (preceding-char) ?\)) (eq (char-after (- (point) 2)) ?*))
      (backward-char)
      (while (n-in-comment-p) (search-backward comment-start))
      (skip-chars-backward " \n\t"))
    (push-mark)
    (setq end (point))
    (cond
     (use-semi
      (if (n-find-kwop ";") (forward-char 2)
	(goto-char (point-min)))
      (skip-chars-forward " \n\t")
      (while (or (looking-at comment-start-skip) (n-in-comment-p))
	(if (= (following-char) ?\)) (forward-char)
	  (search-forward comment-end))
	(skip-chars-forward " \n\t")))
     (t
      (if (not (n-find-kwop n-phrase-start-keywords))
	  (error "No phrase preceding point"))
      (while (and (or (not (bolp))
		      (n-in-comment-p)
		      (n-in-literal-p))
		  (n-find-kwop n-phrase-start-keywords)))))
    (cons (point) end)))

;;itz Fri Sep 25 12:58:13 PDT 1998 support for adding change-log entries
(defun n-current-defun ()
  (save-excursion
    (n-mark-phrase)
    (if (not (looking-at n-phrase-start-keywords)) nil
      (re-search-forward n-phrase-start-keywords)
      (let ((done nil))
        (while (not done)
          (cond
           ((looking-at "\\s ")
            (skip-syntax-forward " "))
           ((char-equal (following-char) ?\( )
            (forward-sexp 1))
           ((char-equal (following-char) ?')
            (skip-syntax-forward "w_"))
           (t (setq done t)))))
      (re-search-forward "\\(\\sw\\|\\s_\\)+")
      (match-string 0))))

(defvar n-last-noncomment-pos nil
  "Caches last buffer position determined not inside a n comment.")
(make-variable-buffer-local 'n-last-noncomment-pos)

;;last-noncomment-pos can be a simple position, because we nil it
;;anyway whenever buffer changes upstream. last-comment-start and -end
;;have to be markers, because we preserve them when the changes' end
;;doesn't overlap with the comment's start.

(defvar n-last-comment-start nil
  "A marker caching last determined n comment start.")
(make-variable-buffer-local 'n-last-comment-start)

(defvar n-last-comment-end nil
  "A marker caching last determined n comment end.")
(make-variable-buffer-local 'n-last-comment-end)

(make-variable-buffer-local 'before-change-function)

(defun n-overlap (b1 e1 b2 e2)
  (<= (max b1 b2) (min e1 e2)))

;this clears the last comment cache if necessary
(defun n-before-change-function (begin end)
  (if (and n-last-noncomment-pos
	   (> n-last-noncomment-pos begin))
      (setq n-last-noncomment-pos nil))
  (if (and (marker-position n-last-comment-start)
	   (marker-position n-last-comment-end)
	   (n-overlap begin end
			 n-last-comment-start
			 n-last-comment-end))
      (prog2
	  (set-marker n-last-comment-start nil)
	  (set-marker n-last-comment-end nil)))
  (let ((orig-function (default-value 'before-change-function)))
    (if orig-function (funcall orig-function begin end))))

(defun n-in-literal-p ()
  "Returns non-nil if point is inside a n literal."
  (let* ((start-literal (concat "[\"" n-quote-char "]"))
	 (char-literal
	  (concat "\\([^\\]\\|\\\\\\.\\|\\\\[0-9][0-9][0-9]\\)"
		  n-quote-char))
	 (pos (point))
	 (eol (progn (end-of-line 1) (point)))
	 state in-str)
    (beginning-of-line 1)
    (while (and (not state)
		(re-search-forward start-literal eol t)
		(<= (point) pos))
      (cond
       ((string= (n-match-string 0) "\"")
	(setq in-str t)
	(while (and in-str (not state)
		    (re-search-forward "\"\\|\\\\\"" eol t))
	  (if (> (point) pos) (setq state t))
	  (if (string= (n-match-string 0) "\"") (setq in-str nil)))
	(if in-str (setq state t)))
       ((looking-at char-literal)
	(if (and (>= pos (match-beginning 0)) (< pos (match-end 0)))
	    (setq state t)
	  (goto-char (match-end 0))))))
    (goto-char pos)
    state))

(defun n-forward-comment ()
  "Skip one (eventually nested) comment."
  (let ((count 1) match)
    (while (> count 0)
      (if (not (re-search-forward "(\\*\\|\\*)" nil 'move))
	  (setq count -1)
	(setq match (n-match-string 0))
	(cond
	 ((n-in-literal-p)
	  nil)
	 ((string= match comment-start)
	  (setq count (1+ count)))
	 (t
	  (setq count (1- count))))))
    (= count 0)))

(defun n-backward-comment ()
  "Skip one (eventually nested) comment."
  (let ((count 1) match)
    (while (> count 0)
      (if (not (re-search-backward "(\\*\\|\\*)" nil 'move))
	  (setq count -1)
	(setq match (n-match-string 0))
	(cond
	 ((n-in-literal-p)
	  nil)
	 ((string= match comment-start)
	  (setq count (1- count)))
	 (t
	  (setq count (1+ count))))))
    (= count 0)))

(defun n-in-comment-p ()
  "Returns non-nil if point is inside a n comment.
Returns nil for the parenthesis openning a comment."
  ;;we look for comments differently than literals. there are two
  ;;reasons for this. first, n has nested comments and it is not so
  ;;clear that parse-partial-sexp supports them; second, if proper
  ;;style is used, literals are never split across lines, so we don't
  ;;have to worry about bogus phrase breaks inside literals, while we
  ;;have to account for that possibility in comments.
  (save-excursion
    (let* ((cached-pos n-last-noncomment-pos)
	   (cached-begin (marker-position n-last-comment-start))
	   (cached-end (marker-position n-last-comment-end)))
      (cond
       ((and cached-begin cached-end
	     (< cached-begin (point)) (< (point) cached-end)) t)
       ((and cached-pos (= cached-pos (point))) nil)
       ((and cached-pos (> cached-pos (point))
	     (< (abs (- cached-pos (point))) n-lookback-limit))
	(let (end found (here (point)))
	  ; go back to somewhere sure
	  (goto-char cached-pos)
	  (while (> (point) here)
	    ; look for the end of a comment
	    (while (and (if (search-backward comment-end (1- here) 'move)
			    (setq end (match-end 0))
			  (setq end nil))
			(n-in-literal-p)))
	    (if end (setq found (n-backward-comment))))
	  (if (and found (= (point) here)) (setq end nil))
	  (if (not end)
	      (setq n-last-noncomment-pos here)
	    (set-marker n-last-comment-start (point))
	    (set-marker n-last-comment-end end))
	  end))	    
       (t
	(let (begin found (here (point)))
	  ; go back to somewhere sure (or far enough)
	  (goto-char
	   (if cached-pos cached-pos (- (point) n-lookback-limit)))
	  (while (< (point) here)
	    ; look for the beginning of a comment
	    (while (and (if (search-forward comment-start (1+ here) 'move)
			    (setq begin (match-beginning 0))
			  (setq begin nil))
			(n-in-literal-p)))
	    (if begin (setq found (n-forward-comment))))
	  (if (and found (= (point) here)) (setq begin nil))
	  (if (not begin)
	      (setq n-last-noncomment-pos here)
	    (set-marker n-last-comment-start begin)
	    (set-marker n-last-comment-end (point)))
	  begin))))))

(defconst n-before-expr-prefix
  (concat "\\<\\(asr\\|begin\\|class\\|do\\(wnto\\)?\\|else"
	  "\\|i\\(f\\|n\\(herit\\|itializer\\)?\\)"
	  "\\|f\\(or\\|un\\(ct\\(ion\\|or\\)\\)?\\)"
	  "\\|l\\(and\\|or\\|s[lr]\\|xor\\)\\|m\\(atch\\|od\\)"
	  "\\|o[fr]\\|parser\\|s\\(ig\\|truct\\)\\|t\\(hen\\|o\\|ry\\)"
	  "\\|w\\(h\\(en\\|ile\\)\\|ith\\)\\)\\>\\|:begin\\>"
	  "\\|[=<>@^|&+-*/$%][!$%*+-./:<=>?@^|~]*\\|:[:=]\\|[[({,;]")

  "Keywords that may appear immediately before an expression.
Used to distinguish it from toplevel let construct.")

(defun n-in-expr-p ()
  (let ((pos (point)) (in-expr t))
    (n-find-kwop
     (concat n-before-expr-prefix "\\|"
	     n-matching-kw-regexp "\\|"
	     (aref n-kwop-regexps n-max-indent-priority)))
    (cond
     ; special case for ;;
     ((and (= (preceding-char) ?\;) (= (following-char) ?\;)))
     ((looking-at n-before-expr-prefix)
      (goto-char (match-end 0))
      (skip-chars-forward " \t\n")
      (while (looking-at "(\\*")
	(forward-char)
	(n-forward-comment)
	(skip-chars-forward " \t\n"))
      (if (<= pos (point)) (setq in-expr nil))))
    (goto-char pos)
    in-expr))

(defun n-at-sexp-close-p ()
  (or (char-equal ?\) (following-char))
      (char-equal ?\] (following-char))
      (char-equal ?} (following-char))))

(defun n-find-kwop (kwop-regexp)
  "Look back for a n keyword or operator matching KWOP-REGEXP.

Ignore occurences inside literals. If found, return a list of two
values: the actual text of the keyword or operator, and a boolean
indicating whether the keyword was one we looked for explicitly
{non-nil}, or on the other hand one of the block-terminating
keywords."
  
  (let ((start-literal (concat "[\"" n-quote-char "]"))
	found kwop)
    (progn
      (while (and (not found)
		  (re-search-backward kwop-regexp nil t))
	(setq kwop (n-match-string 0))
	(cond
	 ((looking-at "(\\*")
	  (backward-char))
	 ((n-in-comment-p)
	  (search-backward "(" nil 'move))
	 ((looking-at start-literal))
	 ((n-in-literal-p)
	  (re-search-backward start-literal))  ;ugly hack
	 ((setq found t)))))
    (if found
	(if (not (string-match "\\`[^|[]|[^]|]?\\'" kwop)) ;arrrrgh!!
	    kwop
	  (forward-char 1) "|") nil)))

;  Association list of indentation values based on governing keywords.
;
;Each element is of the form (KEYWORD OP-TYPE PRIO INDENT). OP-TYPE is
;non-nil for operator-type nodes, which affect indentation in a
;different way from keywords: subsequent lines are indented to the
;actual occurrence of an operator, but relative to the indentation of
;the line where the governing keyword occurs.

(defconst n-no-indent 0)

(defconst n-kwop-alist
  '(("begin" 		nil	6	n-begin-indent)
    (":begin" 		nil	6	n-begin-indent) ; hack
    ("class" 		nil	0	n-class-indent)
    ("constraint"	nil	0	n-val-indent)
    ("sig" 		nil	1	n-sig-indent)
    ("struct" 		nil	1	n-struct-indent)
    ("exception" 	nil	0	n-exception-indent)
    ("for"		nil	6	n-for-indent)
    ("fun"		nil	3	n-fun-indent)
    ("function"		nil	3	n-function-indent)
    ("if"		nil	6	n-if-indent)
    ("if-else"		nil	6	n-if-else-indent)
    ("include"		nil	0	n-include-indent)
    ("inherit"		nil	0	n-inherit-indent)
    ("initializer"	nil	0	n-initializer-indent)
    ("let"		nil	6	n-let-indent)
    ("let-in"		nil	6	n-let-in-indent)
    ("match"		nil	6	n-match-indent)
    ("method"		nil	0	n-method-indent)
    ("module"		nil	0	n-module-indent)
    ("object" 		nil	6	n-object-indent)
    ("of"		nil	7	n-of-indent)
    ("open"		nil	0	n-no-indent)
    ("parser"		nil	3	n-parser-indent)
    ("try"		nil	6	n-try-indent)
    ("type"		nil	0	n-type-indent)
    ("val"		nil	0	n-val-indent)
    ("when"		nil	2	n-if-indent)
    ("while"		nil	6	n-while-indent)
    ("::"		t	5	n-::-indent)
    ("@"		t	4	n-@-indent)
    ("^"		t	4	n-@-indent)
    (":="		nil	3	n-:=-indent)
    ("<-"		nil	3	n-<--indent)
    ("->"		nil	2	n-->-indent)
    ("\["		t	8	n-lb-indent)
    ("{"		t	8	n-lc-indent)
    ("\("		t	8	n-lp-indent)
    ("|"		nil	2	n-no-indent))
; if-else and let-in are not keywords but idioms
; "|" is not in the regexps
; all these 3 values correspond to hard-coded names

"Association list of indentation values based on governing keywords.

Each element is of the form (KEYWORD OP-TYPE PRIO INDENT). OP-TYPE is
non-nil for operator-type nodes, which affect indentation in a
different way from keywords: subsequent lines are indented to the
actual occurrence of an operator, but relative to the indentation of
the line where the governing keyword occurs.")

;;Originally, we had n-kwop-regexp create these at runtime, from an
;;additional field in n-kwop-alist. That proved way too slow,
;;although I still can't understand why. itz

(defconst n-kwop-regexps (make-vector 9 nil)
  "Array of regexps representing n keywords of different priorities.")

(aset n-kwop-regexps 0
      (concat 
       "\\<\\(begin\\|object\\|for\\|s\\(ig\\|truct\\)\\|while\\)\\>"
       "\\|:begin\\>\\|[[({]"))
(aset n-kwop-regexps 1
      (concat (aref n-kwop-regexps 0) "\\|\\<\\(class\\|module\\)\\>"))
(aset n-kwop-regexps 2
      (concat
       (aref n-kwop-regexps 1)
       "\\|\\<\\(fun\\(ction\\)?\\|initializer\\|let\\|m\\(atch\\|ethod\\)"
       "\\|parser\\|try\\|val\\)\\>\\|->"))
(aset n-kwop-regexps 3
      (concat (aref n-kwop-regexps 2) "\\|\\<if\\|when\\>"))
(aset n-kwop-regexps 4
      (concat (aref n-kwop-regexps 3) "\\|:=\\|<-"))
(aset n-kwop-regexps 5
      (concat (aref n-kwop-regexps 4) "\\|@"))
(aset n-kwop-regexps 6
      (concat (aref n-kwop-regexps 5) "\\|::\\|\\^"))
(aset n-kwop-regexps 7
      (concat
       (aref n-kwop-regexps 0)
       "\\|\\<\\(constraint\\|exception\\|in\\(herit\\|clude\\)"
       "\\|o\\(f\\|pen\\)\\|type\\|val\\)\\>"))
(aset n-kwop-regexps 8
      (concat (aref n-kwop-regexps 6)
       "\\|\\<\\(constraint\\|exception\\|in\\(herit\\|clude\\)"
       "\\|o\\(f\\|pen\\)\\|type\\)\\>"))

(defun n-find-done-match ()
  (let ((unbalanced 1) (kwop t))
    (while (and (not (= 0 unbalanced)) kwop)
      (setq kwop (n-find-kwop "\\<\\(done\\|for\\|while\\)\\>"))
      (cond
       ((not kwop))
       ((string= kwop "done") (setq unbalanced (1+ unbalanced)))
       (t (setq unbalanced (1- unbalanced)))))
    kwop))
      
(defun n-find-end-match ()
  (let ((unbalanced 1) (kwop t))
    (while (and (not (= 0 unbalanced)) kwop)
      (setq kwop
	    (n-find-kwop
	     "\\<\\(end\\|begin\\|object\\|s\\(ig\\|truct\\)\\)\\>\\|:begin\\>\\|;;"))
      (cond
       ((not kwop))
       ((string= kwop ";;") (setq kwop nil) (forward-line 1))
       ((string= kwop "end") (setq unbalanced (1+ unbalanced)))
       ( t (setq unbalanced (1- unbalanced)))))
    (if (string= kwop ":begin") "begin"
      kwop)))

(defun n-find-in-match ()
  (let ((unbalanced 1) (kwop t))
    (while (and (not (= 0 unbalanced)) kwop)
      (setq kwop (n-find-kwop "\\<\\(in\\|let\\)\\>"))
      (cond
       ((not kwop))
       ((string= kwop "in") (setq unbalanced (1+ unbalanced)))
       ( t (setq unbalanced (1- unbalanced)))))
    kwop))
  
(defun n-find-with-match ()
  (let ((unbalanced 1) (kwop t))
    (while (and (not (= 0 unbalanced)) kwop)
      (setq kwop
	    (n-find-kwop
	     "\\<\\(with\\|try\\|m\\(atch\\|odule\\)\\|functor\\)\\>\\|{\\|}"))
      (cond
       ((not kwop))
       ((or (string= kwop "module") (string= kwop "functor"))
	(setq unbalanced 0))
       ((or (string= kwop "with") (string= kwop "}"))
	(setq unbalanced (1+ unbalanced)))
       (t (setq unbalanced (1- unbalanced)))))
    kwop))

(defun n-find-paren-match (close)
  (let ((unbalanced 1)
	(regexp (cond ((= close ?\)) "[()]")
		      ((= close ?\]) "[][]")
		      ((= close ?\}) "[{}]"))))
    (while (and (> unbalanced 0)
		(n-find-kwop regexp))
      (if (= close (following-char))
	  (setq unbalanced (1+ unbalanced))
	(setq unbalanced (1- unbalanced))))))

(defun n-find-then-match (&optional from-else)
  (let ((bol (if from-else
		 (save-excursion
		   (progn (beginning-of-line) (point)))))
	kwop done matching-fun)
    (while (not done)
      (setq kwop (n-find-kwop
		  "\\<\\(e\\(nd\\|lse\\)\\|done\\|then\\|if\\)\\>\\|[])};]"))
      (cond
       ((not kwop) (setq done t))
       ((n-at-sexp-close-p)
	(n-find-paren-match (following-char)))
       ((string= kwop "if") (setq done t))
       ((string= kwop "then")
	(if (not from-else) (setq kwop (n-find-then-match))))
       ((setq matching-fun (cdr-safe (assoc kwop n-matching-kw-alist)))
	(setq kwop (funcall matching-fun)))
       ((string= kwop "then")
	(if (not from-else) (setq kwop (n-find-then-match))))))
    (if (and bol (>= (point) bol))
	"if-else"
      kwop)))

(defun n-find-pipe-match ()
  (let ((done nil) (kwop)
	(re (concat
	     "\\<\\(try\\|match\\|with\\|function\\|parser\\|type"
	     "\\|e\\(nd\\|lse\\)\\|done\\|then\\|in\\)\\>"
	     "\\|[^[|]|\\|[])}]")))
    (while (not done)
      (setq kwop (n-find-kwop re))
      (cond
       ((not kwop) (setq done t))
       ((looking-at "[^[|]\\(|\\)")
	(goto-char (match-beginning 1))
	(setq kwop "|")
	(setq done t))
       ((n-at-sexp-close-p)
	(n-find-paren-match (following-char)))
       ((string= kwop "with")
	(setq kwop (n-find-with-match))
	(setq done t))
       ((string= kwop "parser")
	(if (re-search-backward "\\<with\\>" (- (point) 5) t)
	    (setq kwop (n-find-with-match)))
	(setq done t))
       ((string= kwop "done") (n-find-done-match))
       ((string= kwop "end") (n-find-end-match))
       ((string= kwop "then") (n-find-then-match))
       ((string= kwop "else") (n-find-else-match))
       ((string= kwop "in") (n-find-in-match))
       (t (setq done t))))
    kwop))

(defun n-find-and-match ()
  (let ((done nil) (kwop))
    (while (not done)
      (setq kwop (n-find-kwop
		  "\\<\\(object\\|exception\\|let\\|type\\|end\\|in\\)\\>"))
      (cond
       ((not kwop) (setq done t))
       ((string= kwop "end") (n-find-end-match))
       ((string= kwop "in") (n-find-in-match))
       (t (setq done t))))
    kwop))

(defun n-find-else-match ()
  (n-find-then-match t))

(defun n-find-semi-match ()
  (n-find-kwop-skipping-blocks 2))

(defun n-find-comma-match ()
  (n-find-kwop-skipping-blocks 3))

(defconst n-matching-kw-regexp
  (concat
   "\\<\\(and\\|do\\(ne\\)?\\|e\\(lse\\|nd\\)\\|in\\|t\\(hen\\|o\\)"
   "\\|with\\)\\>\\|[^[|]|")
  "Regexp used in n mode for skipping back over nested blocks.")

(defconst n-matching-kw-alist
  '(("|" . n-find-pipe-match)
    (";" . n-find-semi-match)
    ("," . n-find-comma-match)
    ("end" . n-find-end-match)
    ("done" . n-find-done-match)
    ("in"  . n-find-in-match)
    ("with" . n-find-with-match)
    ("else" . n-find-else-match)
    ("then" . n-find-then-match)
    ("to" . n-find-done-match)
    ("do" . n-find-done-match)
    ("and" . n-find-and-match))

  "Association list used in n mode for skipping back over nested blocks.")

(defun n-find-kwop-skipping-blocks (prio)
  "Look back for a n keyword matching n-kwop-regexps [PRIO].

 Skip nested blocks."

  (let ((done nil) (kwop nil) (matching-fun)
	(kwop-list (aref n-kwop-regexps prio)))
    (while (not done)
      (setq kwop (n-find-kwop
		  (concat n-matching-kw-regexp
			  (cond ((> prio 3) "\\|[])},;]\\|")
				((> prio 2) "\\|[])};]\\|")
				(t "\\|[])}]\\|"))
			  kwop-list)))
      (cond
       ((not kwop) (setq done t))
       ((n-at-sexp-close-p)
	(n-find-paren-match (following-char)))
       ((and (>= prio 2) (string= kwop "|")) (setq done t))
       ((string= kwop "end") (n-find-end-match))
       ((string= kwop "done") (n-find-done-match))
       ((string= kwop "in")
	(cond ((and (n-find-in-match) (>= prio 2))
	       (setq kwop "let-in")
	       (setq done t))))
       ((and (string= kwop "parser") (>= prio 2)
	     (re-search-backward "\\<with\\>" (- (point) 5) t))
	(setq kwop (n-find-with-match))
	(setq done t))
       ((setq matching-fun (cdr-safe (assoc kwop n-matching-kw-alist)))
	(setq kwop (funcall matching-fun))
	(if (looking-at kwop-list) (setq done t)))
       (t (let* ((kwop-info (assoc kwop n-kwop-alist))
		 (is-op (and (nth 1 kwop-info)
			     ; check that we are not at beginning of line
			     (let ((pos (point)) bti)
			       (back-to-indentation)
			       (setq bti (point))
			       (goto-char pos)
			       (< bti pos)))))
	    (if (and is-op (looking-at 
			    (concat (regexp-quote kwop)
				    "|?[ \t]*\\(\n\\|(\\*\\)")))
		(setq kwop-list
		      (aref n-kwop-regexps (nth 2 kwop-info)))
	      (setq done t))))))
    kwop))

(defun n-compute-basic-indent (prio)
  "Compute indent of current n line, ignoring leading keywords.

Find the `governing node' for current line. Compute desired
indentation based on the node and the indentation alists.
Assumes point is exactly at line indentation.
Does not preserve point."
  
  (let* (in-expr
	 (kwop (cond
		((looking-at "|\\([^]|]\\|\\'\\)")
		 (n-find-pipe-match))
		((and (looking-at n-phrase-start-keywords)
		      (n-in-expr-p))
		 (n-find-end-match))
		((and (looking-at n-matching-kw-regexp)
		      (assoc (n-match-string 0) n-matching-kw-alist))
		 (funcall (cdr-safe (assoc (n-match-string 0)
				      n-matching-kw-alist))))
		((looking-at
		  (aref n-kwop-regexps n-max-indent-priority))
		 (let* ((kwop (n-match-string 0))
			(kwop-info (assoc kwop n-kwop-alist))
			(prio (if kwop-info (nth 2 kwop-info)
				n-max-indent-priority)))
		   (if (and (looking-at (aref n-kwop-regexps 0))
			    (not (looking-at "object"))
			    (n-in-expr-p))
		       (setq in-expr t))
		   (n-find-kwop-skipping-blocks prio)))
		(t
		 (if (and (= prio n-max-indent-priority) (n-in-expr-p))
		     (setq in-expr t))
		 (n-find-kwop-skipping-blocks prio))))
	 (kwop-info (assoc kwop n-kwop-alist))
	 (indent-diff
	  (cond
	   ((not kwop-info) (beginning-of-line 1) 0)
	   ((looking-at "[[({][|<]?[ \t]*")
	    (length (n-match-string 0)))
	   ((nth 1 kwop-info) (symbol-value (nth 3 kwop-info)))
	   (t 
	    (let ((pos (point)))
	      (back-to-indentation)
;	      (if (looking-at "\\<let\\>") (goto-char pos))
	      (- (symbol-value (nth 3 kwop-info))
		 (if (looking-at "|") n-|-extra-indent 0))))))
	 (extra (if in-expr n-apply-extra-indent 0)))
	 (+ indent-diff extra (current-column))))

(defconst n-leading-kwops-regexp
  (concat
   "\\<\\(and\\|do\\(ne\\)?\\|e\\(lse\\|nd\\)\\|in"
   "\\|t\\(hen\\|o\\)\\|with\\)\\>\\|[]|})]")

  "Regexp matching n keywords which need special indentation.")

(defconst n-leading-kwops-alist
  '(("and" n-and-extra-indent 2)
    ("do" n-do-extra-indent 0)
    ("done" n-done-extra-indent 0)
    ("else" n-else-extra-indent 3)
    ("end" n-end-extra-indent 0)
    ("in" n-in-extra-indent 2)
    ("then" n-then-extra-indent 3)
    ("to" n-to-extra-indent 0)
    ("with" n-with-extra-indent 2)
    ("|" n-|-extra-indent 2)
    ("]" n-rb-extra-indent 0)
    ("}" n-rc-extra-indent 0)
    (")" n-rp-extra-indent 0))

  "Association list of special n keyword indent values.

Each member is of the form (KEYWORD EXTRA-INDENT PRIO) where
EXTRA-INDENT is the variable holding extra indentation amount for
KEYWORD (usually negative) and PRIO is upper bound on priority of
matching nodes to determine KEYWORD's final indentation.")

(defun n-compute-final-indent ()
  (save-excursion
    (back-to-indentation)
    (cond
     ((looking-at comment-start-skip)
      (current-column))
     ((n-in-comment-p)
      (let ((closing (looking-at "\\*)")))
	(n-backward-comment)
	(looking-at comment-start-skip)
	(+ (current-column)
	   (if closing 0 n-comment-indent))))
     (t (let* ((leading (looking-at n-leading-kwops-regexp))
	       (assoc-val (if leading (assoc (n-match-string 0)
					     n-leading-kwops-alist)))
	       (extra (if leading (symbol-value (nth 1 assoc-val)) 0))
	       (prio (if leading (nth 2 assoc-val)
		       n-max-indent-priority))
	       (basic (n-compute-basic-indent prio)))
	  (max 0 (if extra (+ extra basic) (current-column))))))))
		    


(defun n-split-string ()
  "Called whenever a line is broken inside a n string literal."
  (insert-before-markers "\"^\"")
  (backward-char 1))

(defadvice indent-new-comment-line (around
				    n-indent-new-comment-line
				    activate)
  
  "Handle multi-line strings in n mode."

;this advice doesn't make sense in other modes. I wish there were a
;cleaner way to do this: I haven't found one.

  (let ((hooked (and (eq major-mode 'n-mode) (n-in-literal-p)))
	(split-mark))
    (if (not hooked) nil
      (setq split-mark (set-marker (make-marker) (point)))
      (n-split-string))
    ad-do-it
    (if (not hooked) nil
      (goto-char split-mark)
      (set-marker split-mark nil))))  
  
(defadvice newline-and-indent (around
			       n-newline-and-indent
			       activate)

  "Handle multi-line strings in n mode."

    (let ((hooked (and (eq major-mode 'n-mode) (n-in-literal-p)))
	(split-mark))
    (if (not hooked) nil
      (setq split-mark (set-marker (make-marker) (point)))
      (n-split-string))
    ad-do-it
    (if (not hooked) nil
      (goto-char split-mark)
      (set-marker split-mark nil))))

(defun n-electric-pipe ()
  "If inserting a | or } operator at beginning of line, reindent the line.

Unfortunately there is a situation where this mechanism gets
confused. It's when | is the first character of a |] sequence. This is
a misfeature of n syntax and cannot be fixed, however, as a
workaround, the electric ] inserts | itself if the matching [ is
followed by |."
  
  (interactive "*")
  (let ((electric (and n-electric-indent
		       (n-in-indentation)
		       (not (n-in-comment-p)))))
    (self-insert-command 1)
    (if electric
	(let ((indent
	       (save-excursion
		 (backward-char 1)
		 (n-indent-command)
		 (current-column))))
	  (indent-to (- indent
			(symbol-value
			 (nth 1 (assoc
				 (char-to-string last-command-char)
				 n-leading-kwops-alist)))))))))

(defun n-electric-rb ()
  "If inserting a ] operator at beginning of line, reindent the line.

Also, if the matching [ is followed by a | and this ] is not preceded
by |, insert one."

  (interactive "*")
  (let* ((prec (preceding-char))
	 (look-pipe (and n-electric-close-vector
			 (not (n-in-comment-p))
			 (not (n-in-literal-p))
			 (or (not (numberp prec))
			     (not (char-equal ?| prec)))
			 (set-marker (make-marker) (point))))
	 (electric (and n-electric-indent
			(n-in-indentation)
			(not (n-in-comment-p)))))
    (self-insert-command 1)
    (if electric
	(let ((indent
	       (save-excursion
		 (backward-char 1)
		 (n-indent-command)
		 (current-column))))
	  (indent-to (- indent
			(symbol-value
			 (nth 1 (assoc
				 (char-to-string last-command-char)
				 n-leading-kwops-alist)))))))
    (if look-pipe
	(save-excursion
	  (let ((insert-pipe
		 (condition-case nil
		     (prog2
		       (backward-list 1)
		       (if (looking-at "\\[|") "|" ""))
		   (error ""))))
	    (goto-char look-pipe)
	    (insert insert-pipe))
	  (set-marker look-pipe nil)))))		 

(defun n-abbrev-hook ()
  "If inserting a leading keyword at beginning of line, reindent the line."
  ;itz unfortunately we need a special case 
  (if (and (not (n-in-comment-p)) (not (= last-command-char ?_)))
      (let* ((bol (save-excursion (beginning-of-line) (point)))
	     (kw (save-excursion
		   (and (re-search-backward "^[ \t]*\\(\\sw+\\)\\=" bol t)
			(n-match-string 1)))))
	(if kw
	    (let ((indent (save-excursion
			    (goto-char (match-beginning 1))
			    (n-indent-command)
			    (current-column)))
		  (abbrev-correct (if (= last-command-char ?\ ) 1 0)))
	      (indent-to (- indent
			    (or
                             (symbol-value
                              (nth 1
                                   (assoc kw n-leading-kwops-alist)))
                             0)
			    abbrev-correct)))))))

(defun n-indent-phrase ()
  (interactive "*")
  (let ((bounds (n-mark-phrase)))
    (indent-region (car bounds) (cdr bounds) nil)))

(defun n-backward-to-less-indent (&optional n)
  "Move cursor back  N lines with less or same indentation."
  (interactive "p")
  (beginning-of-line 1)
  (if (< n 0) (n-forward-to-less-indent (- n))
    (while (> n 0)
      (let ((i (current-indentation)))
	(forward-line -1)
	(while (or (> (current-indentation) i)
		   (n-in-comment-p)
		   (looking-at
		    (concat "[ \t]*\\(\n\\|" comment-start-skip "\\)")))
	  (forward-line -1)))
      (setq n (1- n))))
  (back-to-indentation))

(defun n-forward-to-less-indent (&optional n)
  "Move cursor back N lines with less or same indentation."
  (interactive "p")
  (beginning-of-line 1)
  (if (< n 0) (n-backward-to-less-indent (- n))
    (while (> n 0)
      (let ((i (current-indentation)))
	(forward-line 1)
	(while (or (> (current-indentation) i)
		   (n-in-comment-p)
		   (looking-at
		    (concat "[ \t]*\\(\n\\|" comment-start-skip "\\)")))
	  (forward-line 1)))
      (setq n (1- n))))
  (back-to-indentation))  

(defun n-insert-begin-form ()
  "Inserts a nicely formatted begin-end form, leaving a mark after end."
  (interactive "*")
  (let ((prec (preceding-char)))
    (if (and (numberp prec) (not (char-equal ?\  (char-syntax prec))))
	(insert " ")))
  (let* ((c (current-indentation)) (i (+ n-begin-indent c)))
    (insert "begin\n\nend")
    (push-mark)
    (indent-line-to c)
    (forward-line -1)
    (indent-line-to i)))

(defun n-insert-for-form ()
  "Inserts a nicely formatted for-do-done form, leaving a mark after do(ne)."
  (interactive "*")
  (let ((prec (preceding-char)))
    (if (and (numberp prec) (not (char-equal ?\  (char-syntax prec))))
	(insert " ")))
  (let* ((c (current-indentation)) (i (+ n-for-indent c)))
    (insert "for  do\n\ndone")
    (push-mark)
    (indent-line-to c)
    (forward-line -1)
    (indent-line-to i)
    (push-mark)
    (beginning-of-line 1)
    (backward-char 4)))
  
(defun n-insert-if-form ()
  "Insert nicely formatted if-then-else form leaving mark after then, else."
  (interactive "*")
  (let ((prec (preceding-char)))
    (if (and (numberp prec) (not (char-equal ?\  (char-syntax prec))))
	(insert " ")))
  (let* ((c (current-indentation)) (i (+ n-if-indent c)))
    (insert "if\n\nthen\n\nelse\n")
    (indent-line-to i)
    (push-mark)
    (forward-line -1)
    (indent-line-to c)
    (forward-line -1)
    (indent-line-to i)
    (push-mark)
    (forward-line -1)
    (indent-line-to c)
    (forward-line -1)
    (indent-line-to i)))

(defun n-insert-match-form ()
  "Insert nicely formatted match-with form leaving mark after with."
  (interactive "*")
  (let ((prec (preceding-char)))
    (if (and (numberp prec) (not (char-equal ?\  (char-syntax prec))))
	(insert " ")))
  (let* ((c (current-indentation)) (i (+ n-match-indent c)))
    (insert "match\n\nwith\n")
    (indent-line-to i)
    (push-mark)
    (forward-line -1)
    (indent-line-to c)
    (forward-line -1)
    (indent-line-to i)))

(defun n-insert-let-form ()
  "Insert nicely formatted let-in form leaving mark after in."
  (interactive "*")
  (let ((prec (preceding-char)))
    (if (and (numberp prec) (not (char-equal ?\  (char-syntax prec))))
	(insert " ")))
  (let* ((c (current-indentation)))
    (insert "let  in\n")
    (indent-line-to c)
    (push-mark)
    (forward-line -1)
    (forward-char (+ c 4))))

(defun n-insert-try-form ()
  "Insert nicely formatted try-with form leaving mark after with."
  (interactive "*")
  (let ((prec (preceding-char)))
    (if (and (numberp prec) (not (char-equal ?\  (char-syntax prec))))
	(insert " ")))
  (let* ((c (current-indentation)) (i (+ n-try-indent c)))
    (insert "try\n\nwith\n")
    (indent-line-to i)
    (push-mark)
    (forward-line -1)
    (indent-line-to c)
    (forward-line -1)
    (indent-line-to i)))

(defun n-insert-while-form ()
  "Insert nicely formatted while-do-done form leaving mark after do, done."
  (interactive "*")
  (let ((prec (preceding-char)))
    (if (and (numberp prec) (not (char-equal ?\  (char-syntax prec))))
	(insert " ")))
  (let* ((c (current-indentation)) (i (+ n-if-indent c)))
    (insert "while  do\n\ndone")
    (push-mark)
    (indent-line-to c)
    (forward-line -1)
    (indent-line-to i)
    (push-mark)
    (beginning-of-line 1)
    (backward-char 4)))

;;; n.el ends here

(provide 'n)
