; ZPL editing support package
; Author E Christopher Lewis
; Date 4 March 1994

(defvar zpl-mode-syntax-table nil
  "Syntax table used in Zpl buffers.")

(defvar zpl-mode-map nil
  "Keymap used in Zpl mode.")

(defvar zpl-compile-command "zpl"
  "Command to compile Zpl programs.")

(setq zpl-indentation-starters "begin\\|then\\|do\\|repeat"
)

(setq zpl-indentation-closers "end\\|until")

(setq zpl-indentation-closers-beg "^\[ \t\]*end\\|^\[ \t\]*else\\|^\[ \t\]*until")

(setq zpl-indentation-closers-no-else-beg "^\[ \t\]*end\\|^\[ \t\]*until")

(setq zpl-region-reg-exp "[ \t]*[\\(with\\(out\\)? \\)?\[a-zA-Z_\]\[a-zA-Z_0-9\]*\\( of \[a-zA-Z_\]\[a-zA-Z_0-9\]*\\)?]"
 )

(setq zpl-region-reg-exp-only (concat "^\[ \t\]*" zpl-region-reg-exp "\[ \t\]*$"))

(setq zpl-region-reg-exp-opt (concat "\\(" zpl-region-reg-exp "\\)?"))

(setq zpl-region-reg-exp2 (concat "^" zpl-region-reg-exp))

(setq zpl-definitions "^\[ \t\]*direction\\|^\[ \t\]*type\\|^\[ \t\]*region\\|^\[ \t\]*var\\|^\[ \t\]*config +var\\|^\[ \t\]*constant")

(setq zpl-break-defs (concat "^\[ \t\n\]*direction\\|^\[ \t\n\]*type\\|^\[ \t\n\]*region\\|^\[ \t\n\]*var\\|^\[ \t\n\]*config +var\\|^\[ \t\n\]*constant\\|^\[ \t\n\]*function\\|^" zpl-region-reg-exp-opt "\[ \t\n\]*begin\\|^" zpl-region-reg-exp-opt "\[ \t\n\]*if\\|^" zpl-region-reg-exp-opt "\[ \t\n\]*while\\^" zpl-region-reg-exp-opt "\[ \t\n\]*repeat\\|^" zpl-region-reg-exp-opt "\[ \t\n\]*for\\^\[ \t\n\]*return"))

(setq zpl-break-break-defs (concat "^\[ \t\n\]*function\\|^" zpl-region-reg-exp-opt "\[ \t\n\]*begin\\|^" zpl-region-reg-exp-opt "\[ \t\n\]*if\\|^" zpl-region-reg-exp-opt "\[ \t\n\]*while\\|^" zpl-region-reg-exp-opt "\[ \t\n\]*repeat\\|^" zpl-region-reg-exp-opt "\[ \t\n\]*for\\|^\[ \t\n\]*return"))

(setq zpl-skip-region-str t)

(setq zpl-region-in-first-column t)


(defvar zpl-skel-prompts t
  "")

(defvar zpl-expr-placeholder " "
  "")

(defvar zpl-single-line-comment "--"
  "")

(defvar zpl-open-comment "/\[*\]")
(setq zpl-close-comment "\[*\]/")

(if zpl-mode-map ()
  (let ((map (make-sparse-keymap)))
    (define-key map "\^i" 'zpl-indent-command)
    (define-key map "\C-cb" 'zpl-begin)
    (define-key map "\C-ci" 'zpl-if)
    (define-key map "\C-cr" 'zpl-repeat)
    (define-key map "\C-cw" 'zpl-while)
    (setq zpl-mode-map map)))

(if zpl-mode-syntax-table
    ()
  (setq zpl-mode-syntax-table (make-syntax-table))
  (modify-syntax-entry ?\\ "\\"  zpl-mode-syntax-table)
  (modify-syntax-entry ?\( ". 1" zpl-mode-syntax-table)
  (modify-syntax-entry ?\) ". 4" zpl-mode-syntax-table)
  (modify-syntax-entry ?/ ". 14" zpl-mode-syntax-table)
  (modify-syntax-entry ?* ". 23" zpl-mode-syntax-table)
  (modify-syntax-entry ?+ "."    zpl-mode-syntax-table)
  (modify-syntax-entry ?- "."    zpl-mode-syntax-table)
  (modify-syntax-entry ?= "."    zpl-mode-syntax-table)
  (modify-syntax-entry ?% "."    zpl-mode-syntax-table)
  (modify-syntax-entry ?< "."    zpl-mode-syntax-table)
  (modify-syntax-entry ?> "."    zpl-mode-syntax-table)
  (modify-syntax-entry ?& "."    zpl-mode-syntax-table)
  (modify-syntax-entry ?| "."    zpl-mode-syntax-table)
  (modify-syntax-entry ?\' "\""  zpl-mode-syntax-table))

(defvar zpl-indent 2 "This variable gives the indentation in Zpl-Mode")
  
(defun zpl-mode ()
  (interactive)
  (kill-all-local-variables)
  (use-local-map zpl-mode-map)
  (make-local-variable 'hi)
  (setq hi ())
  (setq major-mode 'zpl-mode)
  (setq mode-name "Zpl")

  (run-hooks 'zpl-mode-hook))

;;; a bunch of this stuff is not used yet

(defconst zpl-tab-always-indent t
  "*Non-nil means TAB in zpl mode should always reindent the current line,
regardless of where in the line point is when the TAB command is used.")

(defun zpl-indent-command (&optional whole-exp)
  (interactive "P")
  "Indent current line as zpl code, or in some cases insert a tab character.
If zpl-tab-always-indent is non-nil (the default), always indent current line.
Otherwise, indent the current line only if point is at the left margin
or in the line's indentation; otherwise insert a tab.

A numeric argument, regardless of its value,
means indent rigidly all the lines of the expression starting after point
so that this line becomes properly indented.
The relative indentation among the lines of the expression are preserved."
  (if whole-exp
      ;; If arg, always indent this line as Zpl
      ;; and shift remaining lines of expression the same amount.
      (let ((shift-amt (zpl-indent-line))
	    beg end)
	(save-excursion
	  (if zpl-tab-always-indent
	      (beginning-of-line))
	  (setq beg (point))
	  (forward-sexp 1)
	  (setq end (point))
	  (goto-char beg)
	  (forward-line 1)
	  (setq beg (point)))
	(if (> end beg)
	    (indent-code-rigidly beg end shift-amt "#")))
    (if (and (not zpl-tab-always-indent)
	     (save-excursion
	       (skip-chars-backward " \t")
	       (not (bolp))))
	(insert-tab)
      (zpl-indent-line))))


(defun calculate-zpl-indent-within-comment ()
  "Return the indentation amount for line, assuming that
the current line is to be regarded as part of a block comment."
  (let (end star-start)
    (save-excursion
      (beginning-of-line)
      (skip-chars-forward " \t")
      (setq star-start (= (following-char) ?\*))
      (skip-chars-backward " \t\n")
      (setq end (point))
      (beginning-of-line)
      (skip-chars-forward " \t")
      (and (re-search-forward "/\\*[ \t]*" end t)
	   star-start
	   (goto-char (1+ (match-beginning 0))))
      (current-column))))

;;;;;;;;;;;;;;;;;;;;;;;;

(defun zpl-begin ()
  "Insert begin and end."
  (interactive)
  (insert "begin\n\nend;")
  (forward-line -2)
  (beginning-of-line)
  (zpl-indent-line)
  (forward-line 2)
  (beginning-of-line)
  (zpl-indent-line)
  (forward-line -1)
  (beginning-of-line)
  (zpl-indent-line))

(defun zpl-if ()
  "Insert if, then, else, end; prompting for <condition expression>."
  (interactive)
  (save-excursion
    (if zpl-skel-prompts
	(insert "if " (read-string "<condition expression>:") " then")
      (insert "if " zpl-expr-placeholder " then"))
    (insert "\n" zpl-expr-placeholder "\nelse\n" zpl-expr-placeholder "\nend;"))
  (zpl-indent-n-lines 5)
  (if zpl-skel-prompts
      (progn
	(forward-line)
	(end-of-line))
    (beginning-of-line)
    (re-search-forward "if ")))

(defun zpl-while ()
  "Insert while, do, end; prompting for <conditional expression>."
  (interactive)
  (save-excursion
    (if zpl-skel-prompts
	(insert "while " (read-string "<condition expression>:") " do")
      (insert "while " zpl-expr-placeholder " do"))
    (insert "\n" zpl-expr-placeholder "\nend;"))
  (zpl-indent-n-lines 3)
  (if zpl-skel-prompts
      (progn
	(forward-line)
	(end-of-line))
    (beginning-of-line)
    (re-search-forward "while ")))

(defun zpl-repeat ()
  "Insert repeat, until; prompting for <consitional expression>."
  (interactive)
  (save-excursion
    (insert "repeat\n\n")
    (if zpl-skel-prompts
	(insert "until " (read-string "<condition expression>:") ";")
      (insert "until " zpl-expr-placeholder ";")))
  (zpl-indent-n-lines 3)
  (forward-line)
  (end-of-line))

  
  

(defun zpl-indent-n-lines (n)
  "Indent n lines starting with one at point."
  (save-excursion
    (if (not (eq n 0))
	(progn
	  (beginning-of-line)
	  (zpl-indent-line)
	  (forward-line 1)
	  (zpl-indent-n-lines (- n 1))))))


;;;;;;;;;;;;;;;;;;;;;;;
(defun zpl-re-search-backward-point (re &optional bound error)
  "Search backward and return point position if found."
  (interactive)
  (save-excursion
    (if (re-search-backward re bound error)
	(point))))

    
(defun zpl-find-corresponding-starter (depth)
  "Go to the line that 'starts' current indentation."
  (interactive)
  (let ((start-loc)
	(end-loc))
    (setq start-loc 
	  (zpl-re-search-backward-point zpl-indentation-starters nil t))
    (setq end-loc 
	  (zpl-re-search-backward-point zpl-indentation-closers nil t))
    (cond ((and start-loc end-loc)
	   (if (> start-loc end-loc)
	       (setq depth (1- depth))
	     (setq depth (1+ depth)))
	   (goto-char (max start-loc end-loc)))
	  (start-loc
	   (setq depth (1- depth))
	   (goto-char start-loc))
	  (end-loc
	   (setq depth (1+ depth))
	   (goto-char end-loc))
	  (t
	   (setq depth nil)))
    (if depth
	(if (= depth 0)
	    t
	  (zpl-find-corresponding-starter depth))
      nil)))


(defun zpl-first-non-blank-column (&optional ignore-region)
  "Returns the column position of first nonblank char in current line."
  (interactive)
  (save-excursion
    (let ((end nil))
      (end-of-line)
      (setq end (point))
      (beginning-of-line)
      (if ignore-region
	  (re-search-forward zpl-region-reg-exp2 end t))
      (skip-chars-forward " \t")
      (current-column))))

;;(defun zpl-calculate-indent2 ()
;;  "Returns column position to which the current line should be indented."
;;  (interactive)
;;  (save-excursion
;;    (if (re-search-backward zpl-indentation-starters nil t)
;;	(+ zpl-indent (zpl-first-non-blank-column)))))

(defun zpl-calculate-indent ()
  "Returns column position to which the current line should be indented."
  (interactive)
  (save-excursion
    (let ((beg nil)
	  (break-def (zpl-string-in-line-p zpl-break-defs))
	  (closer (zpl-string-in-line-p zpl-indentation-closers-beg))
	  (region (zpl-string-in-line-p zpl-region-reg-exp2))
	  (in-block (zpl-in-block-p))
	  (prev-def (save-excursion
		      (if (re-search-backward zpl-definitions nil t)
			  (point) 0)))
	  (prev-break (save-excursion
			(if (re-search-backward zpl-break-break-defs nil t)
			    (point) 0))))
      (beginning-of-line)
      (if closer
	  (progn
	    (zpl-find-corresponding-starter 1)
	    (zpl-first-non-blank-column t))
	(progn
	  (zpl-skip-back-no-comments)
	  (beginning-of-line)
	  (setq beg (point))
	  (let ((ret (zpl-string-in-line-p zpl-definitions))
		(prev-closer (zpl-string-in-line-p zpl-indentation-closers-no-else-beg)))
	    (if (and ret (not break-def))
		(progn
		  (goto-char ret)
		  (current-column))
	      (if (and break-def (>= prev-def prev-break))
		  0
		(if prev-closer
		    (progn 
		      (save-excursion
			(beginning-of-line)
			(zpl-find-corresponding-starter 1)
			(zpl-first-non-blank-column in-block)))
		  (progn
		    (end-of-line)
		    (if (re-search-backward ";" beg t)
			(zpl-first-non-blank-column region)
		      (if (zpl-string-in-line-p zpl-region-reg-exp-only)
			  (if region
			      (zpl-first-non-blank-column nil)
			    (+ zpl-indent (zpl-first-non-blank-column nil)))
			(+ zpl-indent (zpl-first-non-blank-column in-block))))))))))))))

(defun zpl-string-in-line-p (reg-exp)
  ""
  (interactive)
  (save-excursion
    (let ((end))
      (end-of-line)
      (setq end (point))
      (beginning-of-line)
      (if (re-search-forward reg-exp end t)
	  (progn
	    (skip-chars-forward " \t")
	    (point))))))

	

(defun zpl-skip-back-no-comments ()
  ""
  (interactive)
  (skip-chars-backward " \t\n")
  (forward-char -1)
  (if (eq (following-char) ?/)
      (progn
	(forward-char -1)
	(if (eq (following-char) ?*)
	    (progn
	      (re-search-backward "/[*]" nil t)
	      (zpl-skip-back-no-comments))))
    (let ((loc (zpl-single-line-comment-p (point))))
      (if loc
	  (progn
	    (goto-char loc)
	    (zpl-skip-back-no-comments))))))

(defun zpl-indent-line ()
  "Indents current line as Zpl code."
  (interactive)
  (beginning-of-line)
  (let ((indent (if (zpl-in-comment-p)
		    (calculate-zpl-indent-within-comment)
		  (zpl-calculate-indent)))
	(region-str-len (zpl-region-str-len))
	(beg)
	(end)
	(end-col)
	(beg-col))
    (cond ((eq indent nil)
	   (setq indent (current-indentation))))
    (beginning-of-line)
    (setq beg (point))
    (skip-chars-forward " \t")
    ;;(if (eq (point) (zpl-position-of-next-closer))
    ;;(setq indent (- indent zpl-indent)))
    (if zpl-region-in-first-column
	(progn
	  (skip-chars-forward " \t")
	  (delete-region beg (point))))


    (if zpl-skip-region-str
	(progn
	  (forward-char region-str-len)
	  (setq end (point))
	  (setq end-col (current-column))
	  (skip-chars-backward " \t")
	  (setq beg (point))
	  (setq beg-col (current-column))
	  (if (> beg-col indent)
	      (setq indent (* zpl-indent (+ 1 (/ (- beg-col 0) zpl-indent))))))
      (progn
	;;(setq indent (- indent region-str-len))
	(setq end (point))))
    (delete-region beg end)
    (indent-to indent)))

(defun zpl-region-str-len ()
  ""
  (interactive)
  (save-excursion
    (let ((beg)
	  (end))
      (end-of-line)
      (setq end (point))
      (beginning-of-line)
      (skip-chars-forward " \t")
      (setq beg (point))
      (beginning-of-line)
      (if (re-search-forward zpl-region-reg-exp2 end t)
	  (progn
	    (skip-chars-forward " \t")
	    (- (point) beg))
	0))))
      
   
(defun zpl-position-of-next-closer ()
  ""
  (interactive)
  (save-excursion
    (if (re-search-forward zpl-indentation-closers nil t)
	(progn
	  (re-search-backward zpl-indentation-closers nil t)
	  (point)))))
      

(defun zpl-single-line-comment-p (&optional end)
  "Returns position of comment if line at point contains a single line
   zpl comment; null otherwise."
  (save-excursion
    (let ((beg))
      (beginning-of-line)
      (setq beg (point))
      (if end
	  (goto-char end)
	(end-of-line))
      (if (re-search-backward zpl-single-line-comment beg t)
	  (point)))))
      

(defun zpl-in-comment-p ()
  ""
  (save-excursion
    (let ((open (save-excursion 
		  (let ((x (re-search-backward zpl-open-comment nil t)))
		    (if x (point) 0))))
	  (close (save-excursion 
		   (let ((x (re-search-backward zpl-close-comment nil t)))
		     (if x (point) 0)))))
      (< close open))))

(defun zpl-in-block-p ()
  ""
  (interactive)
  (save-excursion
    (let ((start (save-excursion 
		   (let ((x (re-search-backward zpl-indentation-starters nil t)))
		     (if x (point) 0))))
	  (close (save-excursion
		   (let ((x (re-search-backward zpl-indentation-closers nil t)))
		   (if x (point) 0)))))
      (< close start))))
		      
(defun zpl-inside-parens-p ()
  "From c mode"
  (interactive)
  (condition-case ()
      (save-excursion
	(save-restriction
	  (narrow-to-region (point)
			    (progn (beginning-of-defun) (point)))
	  (goto-char (point-max))
	  (= (char-after (or (scan-lists (point) -1 1) (point-min))) ?\()))
    (error nil)))


;;;notes: indent should do nothing in comment
;; indent properly if in middle of parens
;; indent properly if prev line is assignment