;;; SYNOPSIS: mpas - mosh's turbo pascal mode for emacs,
;;; AUTHOR: GPL(C) Mohsin Ahmed, http://www.cs.albany.edu/~mosh
;;; NOTES:
;;; o Requires pascal.el
;;; o We provide easy way to move by procedures/statements/comments.
;;; o Find matching begin/end/repeat/until/comments/parens.
;;; o So we do regexp searches to find prev/next proc.
;;;   We don't handle recursive proc defns, (nor does pascal mode).
;;; o Only { comments } are bounced, not (* comments *)
;;;   But easy to add if you need.
;;; o pascal.el is really slow with parsing (on win95:586.p133),
;;; o pascal.el doesn't allow customizing of indentation.
;;;   It does a good job of case stmts (hardest to indent?), but has
;;;   Minor quirks with case/begin/else/end combinations.

(setq pascal-mode-hook 'mpas-mode)

(defun mpas-mode () (interactive)
  "Customize turbo pascal mode"
  (setq mode-name  "mpas")
  (mosh-map-local-keys
   ;;            'pascal-beg-of-defun
   ;;            'pascal-end-of-defun
   [  kp-space]  'mpas-match-paren  ; Matches begin/end.
   [C-up     ]   'mpas-prev-func
   [C-down   ]   'mpas-next-func
   [C-kp-up  ]   '(mpas-prev-func '1)
   [C-kp-down]   '(mpas-next-func '1)

   [f12 ?\[]     '(insert "begin\n")
   [f12 ?\]]     '(insert "end\n")
   [f12 ?\{]     '(insert  "begin"
                    comment-start (mosh-which-func) comment-end "\n")
   [f12 ?\}]     '(insert "end"
                    comment-start (mosh-which-func) comment-end "\n")
  )
)

(defvar mpas-func-re
  "\\(procedure\\|function\\|program\\)\\s +\\(\\w+\\)"
  "Regexp which matches pascal functions."
)

(defvar mpas-stmt-re
  (concat
  "\\<\\("
  "begin\\|end"
  "\\|if\\|then\\|else"
  "\\|case\\|of"
  "\\|var\\|const\\|type"
  "\\|for\\|to\\|repeat\\|until\\|while\\|do"
  "\\|function\\|procedure\\|program"
  "\\|and\\|or\\|not\\|xor\\|in"
  "\\)\\>"
  "\\|{\\|}"
  )
  "Regexp which matches pascal statement."
)

(defun mpas-next-func (&optional slow)
  "Goto next pascal: function, statement if slow =1"
  (interactive)

  (if (looking-at "\\<") (forward-word 1))      ;; We always stop at \\<.
  (skip-chars-forward " \t\n")
  (if (looking-at "{") (search-forward "}"))    ;; Comment

  (if (eobp) (error "End of buffer"))
  (cond

   ;; Go Slow? Look for Stmt.
   ((and slow (re-search-forward mpas-stmt-re (point-max) t))
    ;; Skip comments and redo.
    (cond
     ((equal (match-string 0) "{")       ;; We are at beginning of comment.
      (search-forward "}")
      (mpas-next-func slow))
     ((equal (match-string 0) "}")       ;; We were inside a comment.
      (mpas-next-func slow))
     (t (backward-word 1)
        ; (mosh-color-match 'tomato 1)
   )))

   ;; Look for Function
   ((re-search-forward mpas-func-re (point-max) t)
    ; (mosh-color-match 'tomato 1)
    (mosh-color-match 'bold 2))

   (t (message "No more functions"))        ;; Go Slow then.
))

;; procedure test;

(defun mpas-prev-func (&optional slow)
  "Goto prev pascal: function, statement if slow."
  (interactive)
  (skip-chars-backward " \t\n")
  (if (bobp) (error "Beginning of buffer"))
  (cond

   ;; Go Slow? Look for Stmt.
   ((and slow (re-search-backward mpas-stmt-re (point-min) t))

    ;; Skip comments and redo.
    (cond
     ((equal (match-string 0) "}")       ;; We are at end of a comment.
      (search-backward "{")
      (mpas-prev-func slow))
     ((equal (match-string 0) "{")       ;; We were inside a comment.
      (mpas-prev-func slow))
     (t
      ; (mosh-color-match 'tomato 1)
   )))

   ;; Look for Function
   ((re-search-backward mpas-func-re (point-min) t)
    ; (mosh-color-match 'tomato 1)
    (mosh-color-match 'bold 2))

   (t
    (message "No more functions"))        ;; Go Slow then.
  )
)

;;; Need to generalize for case/record/comments not handled.

(defvar mpas-parens (concat
  "\\<\\("
  "begin"     "\\|"
  "case"      "\\|"
  "record"    "\\|"
  "end"       "\\|"
  "repeat"    "\\|"
  "until"     "\\|"
  "{"         "\\|"
  "}"         "\\|"
  "(\\*"      "\\|"
  "\\*)"
  "\\)\\>"
))

(defun mpas-match-paren (&optional findtok count token)
  "A quick way to browse pascal source.
   Goto matching pascal begin/end/repeat/until/()[]{}/other-window,
   Bound to \\[mpas-match-paren]."

  (interactive)

  ;; First time, move cursor to start of keyword.
  ;; (if findtok nil
  ;;   (skip-chars-backward "a-zA-Z"))

  (cond
   ((equal findtok "begin")
     (while (> count 0)
       (re-search-backward mpas-parens (point-min))
       ;; (message "count=%d at point=%d" count (point))
       ; (mosh-color-match  'tomato)
       (setq token (match-string 1))
       (cond
        ((equal token  "}")      (search-backward "{"))
        ;;; Need to handle (* comments *).
        ((equal token  "end")    (setq count (+ count 1)))
        ((equal token  "case")   (setq count (- count 1)))
        ((equal token  "repeat") (setq count (- count 1)))
        ((equal token  "until")  (setq count (+ count 1)))
        ((equal token  "record") (setq count (- count 1)))
        ((equal token  "begin")  (setq count (- count 1))))))

   ((equal findtok "end")
    (while (> count 0)
      (re-search-forward mpas-parens (point-max))
      ;; (message "count=%d at point=%d" count (point))
      ; (mosh-color-match  'tomato)
      (setq token (match-string 1))
      (cond
       ((equal token  "{")      (search-forward "}"))
        ;;; Need to handle (* comments *).
       ((equal token  "end")    (setq count (- count 1)))
       ((equal token  "case")   (setq count (+ count 1)))
       ((equal token  "repeat") (setq count (+ count 1)))
       ((equal token  "until")  (setq count (- count 1)))
       ((equal token  "record") (setq count (+ count 1)))
       ((equal token  "begin")  (setq count (+ count 1))))
    )
    (backward-word 1)
   )

   ((looking-at "\\<\\(begin\\|case\\|record\\|repeat\\)\\>")
    (forward-char)
    (mpas-match-paren "end"    1))

   ((looking-at "\\<\\(end\\|until\\)\\>"  )
    (backward-char)
    (mpas-match-paren "begin"  1))

   ;; '{' matches '}'
   ((looking-at "{") (search-forward "}") (backward-char))
   ((looking-at "}") (search-backward "{"))

   ;; '(*' matches '*)'
   ((looking-at "(\\*")
    (search-forward "*)") (backward-char 2))
   ((looking-at "*)") 
    (search-backward "(*"))

   ;; 'if' matches 'then'.
   ;; but we can't handle 'else' or 'endif' without parsing.
   ((looking-at "\\<if\\>")
    (re-search-forward "\\<then\\>") (backward-char 4))
   ((looking-at "\\<then\\>")
    (re-search-backward "\\<if\\>"))

   ;; 'while' matches 'do'.
   ((looking-at "\\<while\\>")
    (re-search-forward "\\<do\\>") (backward-char 2))
   ((looking-at "\\<do\\>") (re-search-backward "\\<while\\>"))

   ;; 'case' matches 'end'.

   (t (mosh-match-paren-other-window))
))

;;; EOF