;;; (C) Copyright International Business Machines Corporation 23 January 
;;; 1990.  All Rights Reserved. 
;;;  
;;; See the file USERAGREEMENT distributed with this software for full 
;;; terms and conditions of use. 

;; Everything but the indenter

;; For this I just copied from c, the manual specifically doesn't document abbreviation
(defvar hermes-mode-abbrev-table nil
  "Abbreviation table for hermes-mode.")
(define-abbrev-table 'hermes-mode-abbrev-table nil)

(defvar hermes-mode-map nil
  "Keymap used in hermes-mode")
(if hermes-mode-map nil
  (setq hermes-mode-map (make-sparse-keymap))
  (define-key hermes-mode-map "\r" 'h-return-key)
  (define-key hermes-mode-map "\t" 'h-indent-line)
  (define-key hermes-mode-map "\e\C-q" 'h-indent-region)
  (define-key hermes-mode-map "\177" 'backward-delete-char-untabify)
  )

(defvar hermes-mode-syntax-table nil
  "Syntax table for hermes mode.")
(if hermes-mode-syntax-table nil
  (setq hermes-mode-syntax-table (make-syntax-table))
;;  (modify-syntax-entry   hermes-mode-syntax-table)
  (modify-syntax-entry ?\\ "\\" hermes-mode-syntax-table)
  (modify-syntax-entry ?/ ". 14" hermes-mode-syntax-table)
  (modify-syntax-entry ?* ". 23" hermes-mode-syntax-table)
  (modify-syntax-entry ?+ "." hermes-mode-syntax-table)
  (modify-syntax-entry ?- "." hermes-mode-syntax-table)
  (modify-syntax-entry ?= "." hermes-mode-syntax-table)
  (modify-syntax-entry ?% "." hermes-mode-syntax-table)
  (modify-syntax-entry ?< "." hermes-mode-syntax-table)
  (modify-syntax-entry ?> "." hermes-mode-syntax-table)
  (modify-syntax-entry ?& "." hermes-mode-syntax-table)
  (modify-syntax-entry ?| "." hermes-mode-syntax-table)
  (modify-syntax-entry ?\' "\"" hermes-mode-syntax-table)
  )

;; Basic offsets for indentation
(defconst h-keyword-offset 2
  "The amount keywords (e.g. begin, declare) are indented from their surrounding block")
(defconst h-continued-offset 3
  "The amount that continued statements are indented, beyond where a statement would be")
(defconst h-statement-offset 4
  "The amount statements (e.g. i:=1;) are indented from their surrounding block")
  
;; The function "hermes-mode" actually installs everything

(defun hermes-mode ()
  "Enter the major mode for hermes programs"
  (interactive)
  (kill-all-local-variables)
  (use-local-map hermes-mode-map)
  (setq major-mode 'hermes-mode)
  (setq mode-name "Hermes")
  (setq local-abbrev-table hermes-mode-abbrev-table)
  (set-syntax-table hermes-mode-syntax-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 'indent-line-function)
  (setq indent-line-function 'h-indent-line)
  (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 32)
  (make-local-variable 'comment-start-skip)
  (setq comment-start-skip "/\\*+ *")
  (h-calculate-offset-lists)
  (run-hooks 'hermes-mode-hook)
  )

(defun h-return-key () 
  "The procedure that handles the return key. It does an indent-newline-indent."
  (interactive)
  (h-indent-line)
  (newline)
  (h-indent-line)
  )

;; Let emacs know about hermes-mode

(setq auto-mode-alist
      (append
       '(
	 ("\\.d$".hermes-mode)
	 ("\\.p$".hermes-mode)
	 ("\\.bs$".hermes-mode)
	 ("\\.pp$".hermes-mode)
	 ("\\.dd$".hermes-mode)
	 )
       auto-mode-alist
       )
      )
	 

;; The hermes indenter

;; Hermes indentation database

;; Calculate the offset lists
(defun h-calculate-offset-lists () 
  "Recalculate offsets based on h-keyword-offset & h-statement-offset"
  ;; The offsets of tokens relative to the line they are on  
  (setq h-back-keyword-offset (- h-keyword-offset h-statement-offset))
  ;; The list that maps tokens to offsets
  (setq h-offset-list
	(list
	 ;; First the two-token patterns
	 (cons '(h-closep-token.h-constant-token) 0)
	 (cons '(h-closep-token.h-inspect-token) h-back-keyword-offset)
	 (cons '(h-closes-token.h-inspect-token) h-back-keyword-offset)
	 ;; Then the single token patterns
	 (cons 'h-begin-token h-back-keyword-offset)
	 (cons 'h-closeb-token h-back-keyword-offset)
	 (cons 'h-closep-token h-back-keyword-offset)
	 (cons 'h-closes-token h-back-keyword-offset)
	 (cons 'h-constant-token h-back-keyword-offset)
	 (cons 'h-constant-token h-back-keyword-offset)
	 (cons 'h-declare-token h-back-keyword-offset)
	 (cons 'h-declare-token h-back-keyword-offset)
	 (cons 'h-definitions-token h-keyword-offset)
	 (cons 'h-definitions-token h-keyword-offset)
	 (cons 'h-else-token h-back-keyword-offset)
	 (cons 'h-end-token h-back-keyword-offset)
	 (cons 'h-event-token h-back-keyword-offset)
	 (cons 'h-from-token h-back-keyword-offset)
	 (cons 'h-initport-token h-keyword-offset)
	 (cons 'h-of-token h-keyword-offset)
	 (cons 'h-on-token h-back-keyword-offset)
	 (cons 'h-openb-token h-keyword-offset)
	 (cons 'h-openp-token h-keyword-offset)
	 (cons 'h-opens-token h-keyword-offset)
	 (cons 'h-otherwise-token h-back-keyword-offset)
	 (cons 'h-process-token h-keyword-offset)
	 (cons 'h-repeat-token h-back-keyword-offset)
	 (cons 'h-then-token h-back-keyword-offset)
	 (cons 'h-where-token h-back-keyword-offset)
	 )
	)

  ;; The list that maps tokens to indentation deltas 
  (setq h-delta-list
	(list
	 ;; First list the two-token patterns
	 (cons '(h-closep-token.h-inspect-token) 0)
	 (cons '(h-closes-token.h-inspect-token) 0)
	 (cons '(h-end-token.h-block-token) 0)
	 (cons '(h-end-token.h-definitions-token) 0)
	 (cons '(h-end-token.h-for-token) 0)
	 (cons '(h-end-token.h-if-token) 0)
	 (cons '(h-end-token.h-inspect-token) 0)
	 (cons '(h-end-token.h-process-token) 0)
	 (cons '(h-end-token.h-select-token) 0)
	 (cons '(h-end-token.h-while-token) 0)
	 (cons '(h-process-token.h-openp-token) (* 2 h-statement-offset))
	 ;; Then list the one-token patterns
	 (cons 'h-end-token (- h-statement-offset))
	 (cons 'h-block-token h-statement-offset)
	 (cons 'h-closeb-token (- h-statement-offset))
	 (cons 'h-closep-token (- h-statement-offset))
	 (cons 'h-closes-token (- h-statement-offset))
	 (cons 'h-definitions-token h-statement-offset)
	 (cons 'h-evaluate-token h-statement-offset) 
	 (cons 'h-for-token h-statement-offset)
	 (cons 'h-if-token h-statement-offset)
	 (cons 'h-inspect-token h-statement-offset)
	 (cons 'h-openb-token h-statement-offset)
	 (cons 'h-openp-token h-statement-offset)
	 (cons 'h-opens-token h-statement-offset)
	 (cons 'h-process-token 0)
	 (cons 'h-select-token h-statement-offset)
	 (cons 'h-while-token h-statement-offset)
	 )
	)
  )

;; The code that computes indentation
;; The variables that define the keywords that are distinguished as tokens
;;  These functions construct a regexp from a list of strings
(defun option-string (l) 
  "Creates the regexp that will match any string on the list"
  (if (cdr l)
      (concat (regexp-quote (car l)) "\\|" (option-string (cdr l)))
    (regexp-quote (car l))))

(defun search-string (l)
  "Creates the regexp that finds an element of the list"
  (concat "\\(" (option-string l) "\\)\\b\\S_"))

;;  mapping between text strings and token symbols
(setq h-keywords
      '(
       ("begin".h-begin-token)
       ("block".h-block-token)
       ("boolean".h-boolean-token)
       ("callmessage".h-callmessage-token)
       ("constant".h-constant-token)
       ("constraint".h-constraint-token)
       ("declare".h-declare-token)
       ("definitions".h-definitions-token)
       ("else".h-else-token)
       ("end".h-end-token)
       ("enumeration".h-enumeration-token)
       ("evaluate".h-evaluate-token)
       ("event".h-event-token)
       ("exit".h-exit-token)
       ("extract".h-extract-token)
       ("for".h-for-token)
       ("from".h-from-token)
       ("if".h-if-token)
       ("in".h-in-token)
       ("initport".h-initport-token)
       ("inspect".h-inspect-token)
       ("keys".h-keys-token)
       ("minimum".h-minimum-token)
       ("on".h-on-token)
       ("of".h-of-token)
       ("ordered".h-ordered-token)
       ("otherwise".h-otherwise-token)
       ("pragma".h-pragma-token)
       ("process".h-process-token)
       ("record".h-record-token)
       ("remove".h-remove-token)
       ("repeat".h-repeat-token)
       ("select".h-select-token)
       ("table".h-table-token)
       ("then".h-then-token)
       ("using".h-using-token)
       ("linking".h-linking-token)
       ("where".h-where-token)
       ("while".h-while-token)
       )
      )
(setq h-punctuation 
      '(
       (?\(.h-openp-token)
       (?\{.h-openb-token)
       (?\[.h-opens-token)
       (?\).h-closep-token)
       (?\}.h-closeb-token)
       (?\].h-closes-token)
       (?\;.h-semi-token)
       (?\,.h-comma-token)
       (?\:.h-colon-token)
       )
      )
;; Create the regular expression that matches all of them
(setq h-keywords-regexp
      (search-string (mapcar 'car h-keywords)))

;; The variables that define the characters that are distinguished as tokens
;; The function that converts a text line into a list of tokens
(defun h-backwards-token-list () 
"Convert the text from the point to the next newline into a token list."
(let (result key nextchar nextclass start)
  (while (not (eolp))
    (skip-chars-forward " \t")
;; Match the following characters as a token
    (setq nextchar (following-char))
    (setq nextclass (char-syntax nextchar))
    (cond
     ((and (<= nextchar ?9) (>= nextchar ?0))
      (setq result (cons 'h-number-literal-token result))
      (looking-at "[0-9\\.]+\\([eE][+-]?[0-9]+\\)?")
      (goto-char (match-end 0)))
     ((or (eq nextclass ?w) (eq nextclass ?_))
      (setq start (point))
      (skip-chars-forward "A-Za-z0-9\\._")
      (setq result
	    (cons 
	     (or
	      (cdr (assoc (downcase (buffer-substring start (point))) h-keywords))
	      'h-word-token)
	     result)))
     ((eq nextchar  ?\")
      (forward-char)
      (setq result (cons 'h-string-literal-token result))
      (re-search-forward "\\(\"\\|\n\\)" (point-max) 'move))
     ((eq nextchar  ?\')
      (forward-char)
      (setq result (cons 'h-named-literal-token result))
      (re-search-forward "\\(\'\\|\n\\)" (point-max) 'move))
     ((eq nextchar  ?/)
      (forward-char)
      (if (not (eq (following-char) ?\*))
	  (setq result (cons 'h-punctuation-token result))
	(forward-char)
	(re-search-forward "\\(\\*/\\|\n\\)" (point-max) 'move)))
     ((eq nextchar  ?-)
      (forward-char)
      (if (not (eq (following-char) ?-))
	  (setq result (cons 'h-number-literal-token result))
	(end-of-line)))
     ((setq key (assoc nextchar h-punctuation))
      (forward-char)
      (setq result (cons (cdr key) result)))
     ((eq nextchar ?\n))
     (t 
      (forward-char)
      (setq result (cons 'h-punctuation-token result)))
     )
    )
  result
  )
)

(defun h-token-list-last () 
"Convert the text from the point to the next newline into a token list."
(let (result key nextchar nextclass start)
  (while (not (eolp))
    (skip-chars-forward " \t")
;; Match the following characters as a token
    (setq nextchar (following-char))
    (setq nextclass (char-syntax nextchar))
    (cond
     ((and (<= nextchar ?9) (>= nextchar ?0))
      (setq result 'h-number-literal-token)
      (looking-at "[0-9\\.]+\\([eE][+-]?[0-9]+\\)?")
      (goto-char (match-end 0)))
     ((or (eq nextclass ?w) (eq nextclass ?_))
      (setq start (point))
      (skip-chars-forward "A-Za-z0-9\\._")
      (setq result
	    (or
	     (cdr (assoc (downcase (buffer-substring start (point))) h-keywords))
	     'h-word-token)))
     ((eq nextchar  ?\")
      (forward-char)
      (setq result 'h-string-literal-token)
      (re-search-forward "\\(\"\\|\n\\)" (point-max) 'move))
     ((eq nextchar  ?\')
      (forward-char)
      (setq result 'h-named-literal-token)
      (re-search-forward "\\(\'\\|\n\\)" (point-max) 'move))
     ((eq nextchar  ?/)
      (forward-char)
      (if (not (eq (following-char) ?\*))
	  (setq result 'h-punctuation-token)
	(forward-char)
	(re-search-forward "\\(\\*/\\|\n\\)" (point-max) 'move)))
     ((eq nextchar  ?-)
      (forward-char)
      (if (not (eq (following-char) ?-))
	  (setq result 'h-number-literal-token)
	(end-of-line)))
     ((setq key (assoc nextchar h-punctuation))
      (forward-char)
      (setq result (cdr key)))
     ((eq nextchar ?\n))
     (t 
      (forward-char)
      (setq result 'h-punctuation-token result))
     )
    )
  result
  )
)

(defun h-token-list () 
  "Convert the text from the point to the next newline into a token list."
  (nreverse (h-backwards-token-list))
  )

;; This function sums a list of tokens (modified by a predecessor)
;; to calculate the delta indentation to the next line

(defun h-delta-indentation (pred list)
  (let ((sum 0) pair)
    (while list
;; First check for a double pattern
      (or 
       (setq pair (assoc (cons pred (car list)) h-delta-list))
       (setq pair (assoc (car list) h-delta-list)))
      (if pair (setq sum (+ sum (cdr pair))))
      (setq pred (car list))
      (setq list (cdr list))
      )
    sum
    )
  )

;; The tokens that are never continuations
(setq h-newline-list
      '(
	h-then-token
	h-else-token
	h-event-token
	h-end-token
	h-constant-token
	h-minimum-token
	h-exit-token
	h-closep-token
	h-closes-token
	h-closeb-token
	)
      )
;; Compute offsets
(defun h-offset (pred tok) 
  (if (memq tok h-newline-list) 
      (or 
       (cdr (assoc (cons pred tok) h-offset-list))
       (cdr (assoc tok h-offset-list)) 0)
    (if (h-continuedp tok)
	h-continued-offset
      (or 
       (cdr (assoc (cons pred tok) h-offset-list))
       (cdr (assoc tok h-offset-list)) 0)
      )
    )
  )

;; Detect lines that don't affect indentation
(defun h-foreignp ()
  "This predicate determines whether a line is foreign (a preprocessor line)"
  (save-excursion
    (beginning-of-line)
    (or
     (looking-at "[ \t]*#") 
     (if (bobp)
	 nil
       (backward-char 1)
       (skip-chars-backward " \t")
       (and (eq (preceding-char) ?\\ )
	    (progn
	      (beginning-of-line)
	      (h-foreignp)))
       )
     )
    )
  )

(defun h-emptyp ()
  "Whether a line is empty from the point of view of the indenter"
    (or
     (save-excursion (beginning-of-line) (looking-at "[ \t]*\n"))
     (h-foreignp)
   )
  )

;;Compute continuation
(defun h-predecessor ()
  "This returns the last token before the current line"
  (let (last)
    (save-excursion
      (beginning-of-line)
      (if (not (eq (forward-line -1) 0))
	  ;; If it has no predecessor, it can't be a continuation
	  nil
	;; Go back to a nonblank line
	(while
	    (and (or (h-emptyp)
		     (not (save-excursion (setq last (h-token-list-last))))
		     )
		 (not (bobp)))
	  (forward-line -1)
	  )
	last
	)
      )
    )
  )
(defun h-last2 ()
  "This returns the last two tokens token before the current line"
  (let (last toks)
    (save-excursion
      (beginning-of-line)
      (if (not (eq (forward-line -1) 0))
	  ;; If it has no predecessor, it can't be a continuation
	  nil
	;; Go back to a nonblank line
	(while
	    (and (or (h-emptyp)
		     (not (save-excursion (setq toks (h-backwards-token-list))))
		     )
		 (not (bobp)))
	  (forward-line -1)
	  )
	(cons (car toks)
	      (or
	       (car (cdr toks))
	       (h-predecessor)
	       )
	      )
	)
      )
    )
  )

(defun h-previous-first ()
  "This returns the first token on the line before the current line"
  (let (first)
    (save-excursion
      (beginning-of-line)
      (if (not (eq (forward-line -1) 0))
	  ;; If it has no predecessor, it can't be a continuation
	  nil
	;; Go back to a nonblank line
	(while
	    (and (or (h-emptyp)
		     (not (save-excursion 
			    (setq first (h-first)))
			  )
		     )
		 (not (bobp)))
	  (forward-line -1)
	  )
	first
	)
      )
    )
  )

(defun h-first ()
  "This returns the first token on the current line"
(let (result key nextchar nextclass start)
  (beginning-of-line)
  (skip-chars-forward " \t")
  (if (eolp) nil
    (setq nextchar (following-char))
    (setq nextclass (char-syntax nextchar))
    (cond
     ((and (<= nextchar ?9) (>= nextchar ?0))
      'h-number-literal-token)
     ((or (eq nextclass ?w) (eq nextclass ?_))
      (setq start (point))
      (skip-chars-forward "A-Za-z0-9\\._")
      (or
       (cdr (assoc (downcase (buffer-substring start (point))) h-keywords))
       'h-word-token))
     ((eq nextchar  ?\")
      'h-string-literal-token)
     ((eq nextchar  ?\')
      'h-named-literal-token)
     ((eq nextchar  ?/)
      (forward-char)
      (if (not (eq (following-char) ?\*))
	  'h-punctuation-token))
     ((eq nextchar  ?-)
      (forward-char)
      (if (not (eq (following-char) ?-))
	  'h-number-literal-token))
     ((setq key (assoc nextchar h-punctuation))
      (cdr key))
     ((eq nextchar ?\n))
     (t 'h-punctuation-token result)
     )
    )
  )
)

;; List of tokens & pairs that terminate a statement
(setq h-terminate-list 
      '(
;; First the pairs
	(h-word-token.h-event-token)
	(h-word-token.h-inspect-token)
	(h-word-token.h-colon-token)
;; Now the tokens
	h-begin-token
	h-block-token
	h-boolean-token
	h-callmessage-token
	h-closeb-token
	h-closes-token
	h-colon-token
	h-comma-token
	h-declare-token
	h-definitions-token
	h-else-token
	h-end-token
	h-enumeration-token
	h-evaluate-token
	h-from-token
	h-inspect-token
	h-openb-token
	h-openp-token
	h-opens-token
	h-otherwise-token
	h-record-token
	h-repeat-token
	h-select-token
	h-semi-token
	h-then-token
	nil
       )
      )


(defun member (p l)
  (and l
       (or
	(equal p (car l))
	(member p (cdr l)))
       )
  )

(setq h-termination-closep-list
      '(
	h-callmessage-token
	h-constant-token
	h-exit-token
	h-on-token
	h-process-token
	h-select-token
	h-using-token
	h-linking-token
	h-where-token
	h-while-token
	)
      )

(defun h-previous-toks () ""
  (let ((toks nil))
    (beginning-of-line)
    (if (not (eq (forward-line -1) 0))
	;; Just use 0 for base and delta
	nil
      ;; Go back to a nonblank line
      (while
	  (and (or (h-emptyp)
		   (not (setq toks (h-backwards-token-list))))
	       (not (bobp)))
	(forward-line -1)
	)
      )
    toks
    )
  )

(defun h-termination-closep () ""
  ;; Find the token before the matching "(", see if it is on the list
  (let (toks match depth)
    (save-excursion
      (setq toks (or (cdr (h-previous-toks)) (h-previous-toks)))
      (setq depth 1)
      (while (and (> depth 0) toks)
	(if (eq (car toks) 'h-openp-token) (setq depth (1- depth)))
	(if (eq (car toks) 'h-closep-token) (setq depth (1+ depth)))
	(or (setq toks (cdr toks))
	    (bobp)
	    (setq toks (h-previous-toks))
	    )
	)
      (if (eq depth 0)
	  (setq match (if toks (car toks) (h-token-list-last))))
      (memq match h-termination-closep-list)
      )
    )
  )

(defun h-continuedp (start)
  "Determines whether a line is a continuation of the line before it."
  (let ((last (h-last2)))
    (cond 
     ((memq (car last) h-terminate-list) nil)
     ((member last h-terminate-list) nil)
     ((and (eq (car last) 'h-closep-token) (h-termination-closep)) nil)
     ((and (eq start 'h-where-token) (not (equal last '(h-word-token.h-in-token)))) nil)
     (t t)
     )
    )
  )

;; Compute the correct indentation of a line
(defun h-compute-indentation () 
  (let ((base 0) (delta 0) (offset 0) toks pred physical)
    ;; Compute the base and delta of the previous line
    (save-excursion
      (beginning-of-line)
      (if (not (eq (forward-line -1) 0))
	  ;; Just use 0 for base and delta
	  nil
	;; Go back to a nonblank line
	(while
	    (and (or (h-emptyp)
		     (not (save-excursion (setq toks (h-token-list)))))
		 (not (bobp)))
	  (forward-line -1)
	  )
	;; Process the line
	(beginning-of-line)
	(setq physical (current-indentation))
	(setq delta (h-delta-indentation (h-predecessor) toks))
	(setq base (- physical (h-offset (h-predecessor) (car toks))))
	)
      )
;; Compute the offset of the current line
    (save-excursion
      (end-of-line)
      (if (eobp) (save-excursion (insert "\n")))
      (beginning-of-line)
      (setq offset (+ (h-offset (h-predecessor) (car (h-token-list)))))
      )
;; Add them all together
    (+ base delta offset)
    )
  )


;; Change the current indentation
(defun h-indent-line ()
  "Indent a line to its correct indentation."
  (interactive)
  (if (h-foreignp) nil
    (let ((correct (h-compute-indentation))
	  (cur (current-indentation))
	  col
	  ofs)
      (setq col (current-column))
      (if (< col cur)
	  (save-excursion
	    (move-to-column cur)
	    (setq ofs (- (point-max) (point))))
	(setq ofs (- (point-max) (point))))
      (if (eq correct cur) nil
	(beginning-of-line)
	(delete-horizontal-space)
	(if (> correct 0) (indent-to correct))
	)
      (goto-char (- (point-max) ofs))
      )
    )
  )

(defun h-indent-region ()
  "Indent all the lines that start between point and mark"
  (interactive)
  (save-excursion
    (goto-char (region-beginning))
    (if (not (bolp)) (beginning-of-line 2))
    (while (< (point) (region-end))
      (h-indent-line)
      (beginning-of-line 2)
      )
    )
  )


;;; Following function is supplied for use in batch-mode from the 
;;; 'indent-hermes' shell script, since functions invoked via the emacs 
;;; command line must not require arguments
(defun untabify-whole-buffer ()
  (untabify (point-min) (point-max))
  )
