;; Darwin code editing commands for Emacs
;; Copyright (C) 1992 ETH Zurich
;; Written December 1992 by Lukas Knecht

;; This file is free software in the sense of the Free Software Foundation
;; public license.

(defvar darwin-mode-map ()
  "Keymap used in Darwin mode.")
(if darwin-mode-map ()
  (setq darwin-mode-map (make-sparse-keymap))
  (define-key darwin-mode-map "\t" 'darwin-indent-line)
  (define-key darwin-mode-map "\C-m" 'darwin-newline)
  (define-key darwin-mode-map "\C-cp" 'darwin-proc)
  (define-key darwin-mode-map "\C-ci" 'darwin-if)
  (define-key darwin-mode-map "\C-cf" 'darwin-for)
  (define-key darwin-mode-map "\C-ch" 'darwin-header)
  (define-key darwin-mode-map "\C-cw" 'darwin-while)
  (define-key darwin-mode-map "\M-q" 'darwin-indent-paragraph))

(defconst darwin-indent-level 2
  "*Indentation of darwin statements with respect to previous line.")
(defconst darwin-remove-semicolon nil
  "*If non-nil, automatically removes superfluous colons and semicolons at the end of darwin lines.")

(defvar darwin-mode-syntax-table t
  "Syntax table in use in Darwin-mode buffers.")

(if darwin-mode-syntax-table
    ()
  (setq darwin-mode-syntax-table (make-syntax-table))
  (modify-syntax-entry ?\\ "\\" darwin-mode-syntax-table)
  (modify-syntax-entry ?/  "." darwin-mode-syntax-table)
  (modify-syntax-entry ?*  "." darwin-mode-syntax-table)
  (modify-syntax-entry ?+  "." darwin-mode-syntax-table)
  (modify-syntax-entry ?-  "." darwin-mode-syntax-table)
  (modify-syntax-entry ?=  "." darwin-mode-syntax-table)
  (modify-syntax-entry ?^  "." darwin-mode-syntax-table)
  (modify-syntax-entry ?<  "." darwin-mode-syntax-table)
  (modify-syntax-entry ?>  "." darwin-mode-syntax-table)
  (modify-syntax-entry ?\' "\"" darwin-mode-syntax-table)
  (modify-syntax-entry ?\" "." darwin-mode-syntax-table)
  (modify-syntax-entry ?#  "<" darwin-mode-syntax-table)
  (modify-syntax-entry ?\n ">" darwin-mode-syntax-table))

(defun darwin-prev-nonblank ()
  "Search preceding non-blank line, return t if found."
  (interactive)
  (setq stop nil)
  (while (and (> (point) 1) (not stop))
    (forward-line -1)
    (cond ((or (looking-at "\\s *\n") (looking-at "\\s *#")) ())
	  (t (setq stop t))))
  stop)

(defun darwin-check-prevcontexpr ()
  "If the previous line ends a continued expression, returns the indentation
of the starting assignment statement, nil otherwise."
  (setq res nil)
  (setq curpos2 (point))
  (beginning-of-line)
  ;; check whether this line continues an expression
  (setq contexpr2 (looking-at expression-chars))
  (cond ((darwin-prev-nonblank)
	 (end-of-line)
	 (skip-chars-backward " \t")
	 (forward-char -1)
	 ;; if it continues or the preceding line is to be continued,
	 ;; search for the assignment character
	 (cond ((or contexpr2 (looking-at expression-chars))
		(while (and (> (point) 1) (not (looking-at "\:\\|\;")))
		  (forward-char -1))
		(cond ((looking-at "\:\=")
		       (setq res (current-indentation))))))))
  (goto-char curpos2)
  res)

(defun calculate-darwin-indent ()
  "Returns appropriate indentation for current line as Darwin code."
  (let ((case-fold-search nil))
    (setq curpos (point))
    (setq indent2 0)
    (setq nocolon nil)
    ;; check whether we should move the line out
    (beginning-of-line)
    (cond ((looking-at "\\s *\\(fi\\|else\\|elif\\|od\\|end\\)\\>")
	   (setq indent2 (- indent2 darwin-indent-level))
	   (setq nocolon darwin-remove-semicolon)))
    ;; check whether this is a continued expression
    (setq expression-chars "\\s *\\(\+\\|\-\\|\*\\|\/\\|\^\\|\=\\|\<\\|\>\\)")
    (setq contexpr (looking-at expression-chars))
    (cond ((darwin-prev-nonblank)
	   (setq indent (current-indentation))
	   ;; look at last character of preceding line
	   (end-of-line)
	   (skip-chars-backward " \t")
	   ;; remove trailing semicolon or colon, if requested
	   (cond ((and nocolon (or (= (preceding-char) ?\;)
				   (= (preceding-char) ?\:)))
		  (delete-char -1)
		  (setq curpos (1- curpos))))
	   (forward-char -1)
	   ;; check whether this is a continued expression
	   (cond ((looking-at expression-chars) (setq contexpr t)))
	   ;; check whether the previous line is a continued expression
	   (cond ((not contexpr)
		  (setq prevcontexpr (darwin-check-prevcontexpr))
		  (cond (prevcontexpr (setq indent prevcontexpr)))))
	   (beginning-of-line)
	   ;; check whether the line contains only fi/od/end and count parens
	   (cond ((looking-at "\\s *\\(fi\\|od\\|end\\)\\>"))
		 (t
		  ;; scan the line from the end for move in/out tokens
		  (setq beg (point))
		  (setq str nil)
		  (setq paren 0)
		  (setq parenpos nil)
		  (setq assignpos nil)
		  (setq ifind darwin-indent-level)
		  (end-of-line)
		  (while (> (point) beg)
		    (forward-char -1)
		    (cond (str
			   (cond ((looking-at "\\s\"") (setq str nil))))
			  (t 
			   (cond ((looking-at "\\s\"") (setq str t))
				 ((looking-at "\\s(")
				  (setq paren (1+ paren))
				  (cond ((and (> paren 0) (not parenpos))
					 (setq parenpos (current-column)))))
				 ((looking-at "\\s)") (setq paren (1- paren)))
				 ((looking-at "\:\=")
				  (setq assignpos (current-column)))
				 ((looking-at "\\<if\\>")
				  (setq indent (+ indent ifind)))
				 ((looking-at "\\<\\(else\\|elif\\)\\>")
				  (setq indent (+ indent ifind))
				  (setq ifind 0))
				 ((looking-at "\\<\\(do\\|proc\\)\\>")
				  (setq indent (+ indent darwin-indent-level)))
				 ((looking-at "\\<\\(fi\\|end\\|od\\)\\>")
				  (setq indent (- indent darwin-indent-level)))))))
		  ;; special case: there were too many closing parentheses,
		  ;; continue until you find the line that opens it; re-analyze it
		  (cond ((< paren 0)
			 (setq str nil)
			 (while (and (> (point) 1) (< paren 0))
			   (forward-char -1)
			   (cond (str
				  (cond ((looking-at "\\s\"") (setq str nil))))
				 (t 
				  (cond ((looking-at "\\s\"") (setq str t))
					((looking-at "\\s(") (setq paren (1+ paren)))
					((looking-at "\\s)") (setq paren (1- paren)))))))
			 (setq thisparpos (point))
			 (setq paren 0)
			 (setq parenpos nil)
			 (beginning-of-line)
			 (setq indent (current-indentation))
			 (setq beg (point))
			 (setq str nil)
			 (setq ifind darwin-indent-level)
			 (end-of-line)
			 (while (> (point) beg)
			   (forward-char -1)
			   (cond (str
				  (cond ((looking-at "\\s\"") (setq str nil))))
				 (t 
				  (cond ((looking-at "\\s\"") (setq str t))
					((and (looking-at "\\s(") 
					      (< (point) thisparpos))
					 (setq paren (1+ paren))
					 (cond ((and (> paren 0) (not parenpos))
						(setq parenpos (current-column)))))
					((and (looking-at "\\s)")  
					      (< (point) thisparpos))
					 (setq paren (1- paren)))
					((looking-at "\\<if\\>")
					 (setq indent (+ indent ifind)))
					((looking-at "\\<\\(else\\|elif\\)\\>")
					 (setq indent (+ indent ifind))
					 (setq ifind 0))
					((looking-at "\\<\\(do\\|proc\\)\\>")
					 (setq indent (+ indent darwin-indent-level)))
					((looking-at "\\<\\(fi\\|end\\|od\\)\\>")
					 (setq indent (- indent darwin-indent-level)))))))
			 (cond (parenpos (setq indent (1+ parenpos)))))
			;; opening parenthesis: use parenthesis position + 1
			(parenpos (setq indent (1+ parenpos)))
			;; continued expression: use := position + 3
			((and contexpr assignpos)
			 (setq indent (+ assignpos 3))))))
	   (setq indent (+ indent indent2)))
	  (t 
	   (goto-char curpos)
	   (setq indent (current-indentation))))
    (goto-char curpos)
    indent))

(defun darwin-indent-line ()
  "Indents the current darwin line corresponding to previous line."
  (interactive)
  (let ((indent (calculate-darwin-indent))
	(pos (- (point-max) (point))))
    (beginning-of-line)
    (setq beg (point))
    (skip-chars-forward " \t")
    (setq shift-amt (- indent (current-column)))
    (if (zerop shift-amt)
	(if (> (- (point-max) pos) (point))
	    (goto-char (- (point-max) pos)))
      (delete-region beg (point))
      (indent-to indent)
      (if (> (- (point-max) pos) (point))
	  (goto-char (- (point-max) pos))))
    shift-amt))

(defun darwin-newline ()
  "Insert a new line and indent there."
  (interactive)
  ;; re-indent current line if it contains out-indent statement
  (setq curpos (point))
  (beginning-of-line)
  (setq doit (looking-at "\\s *\\(fi\\|else\\|elif\\|od\\|end\\)\\>"))
  (goto-char curpos)
  (cond (doit (darwin-indent-line)))
  (newline)
  (darwin-indent-line)
  (darwin-add-blanks))
  
(defun darwin-proc ()
  "Insert a darwin ':= proc .. end' template."
  (interactive)
  (darwin-indent-line)
  (insert " := proc (")
  (setq p (point))
  (insert ")")
  (darwin-newline)
  (insert "end:")
  (darwin-indent-line)
  (darwin-newline)
  (goto-char p))

(defun darwin-if ()
  "Insert a darwin 'if .. then .. fi' template."
  (interactive)
  (darwin-indent-line)
  (insert "if ")
  (setq p (point))
  (insert " then")
  (darwin-newline)
  (insert "fi;")
  (darwin-indent-line)
  (darwin-newline)
  (goto-char p))

(defun darwin-for ()
  "Insert a darwin 'for .. do .. od' template."
  (interactive)
  (darwin-indent-line)
  (insert "for ")
  (setq p (point))
  (insert " do")
  (darwin-newline)
  (insert "od;")
  (darwin-indent-line)
  (darwin-newline)
  (goto-char p))

(defun darwin-while ()
  "Insert a darwin 'while .. do .. od' template."
  (interactive)
  (darwin-indent-line)
  (insert "while ")
  (setq p (point))
  (insert " do")
  (darwin-newline)
  (insert "od;")
  (darwin-indent-line)
  (darwin-newline)
  (goto-char p))

(defun darwin-header ()
  "Insert a header for a darwin file."
  (interactive)
  (darwin-indent-line)
  (insert "# Purpose: ")
  (setq p (point))
  (darwin-newline)
  (insert "# Author:  " (user-full-name))
  (darwin-newline)
  (setq curdate (current-time-string))
  (insert "# Created: " 
	  (substring curdate 8 10)
	  (substring curdate 3 7)
	  (substring curdate 19 24))
  (darwin-newline)
  (insert "#")
  (darwin-newline)
  (goto-char p))

(defun darwin-indent-paragraph ()
  "Indent the complete paragraph."
  (interactive)
  (setq here (point-marker))
  (beginning-of-line)
  (while (and (> (point) 1) (not (looking-at "\\s *\n")))
    (forward-line -1))
  (cond ((looking-at "\\s *\n") (forward-line 1)))
  (while (and (< (point) (point-max)) (not (looking-at "\\s *\n")))
    (darwin-indent-line)
    (forward-line 1))
  (darwin-indent-line)
  (goto-char (marker-position here))
  (set-marker here nil))

(defun darwin-mode ()
  "This mode supports program development in Darwin."
  (interactive)
  (kill-all-local-variables)
  (use-local-map darwin-mode-map)
  (setq major-mode 'darwin-mode)
  (setq mode-name "Darwin")
  (set-syntax-table darwin-mode-syntax-table)
  (make-local-variable 'indent-line-function)
  (setq indent-line-function 'darwin-indent-line)
  (make-local-variable 'parse-sexp-ignore-comments)
  (setq parse-sexp-ignore-comments nil)
  (run-hooks 'darwin-mode-hook))

(defun darwin-add-blanks ()
  "Put blanks around +- := etc"
  (interactive)
  (insert "while ")
  (setq p (point))
  (insert " do")
  (insert "od;")
  (goto-char p))