From: bochner@das.harvard.edu (Harry Bochner)
Subject: Re: 4GL mode file for EMACS
Date: Tue, 14 Dec 1993 22:28:31 GMT
Organization: Aiken Computation Lab, Harvard University
X-Informix-List-Id: <news.5102>

Here's what I use, attached below.
It works with GNU emacs 18.57.

Disclaimer: I wrote this several years ago, don't remember how it works, and
would probably approach the problem differently if I worked on it again. It's
incomplete, does various things wrong, and isn't easy to customize.

But it works well enough that I haven't been motivated to rewrite it.
Feel free to use it if you find it useful.
-- 
Harry Bochner
bochner@das.harvard.edu
----------------4lg-mode.el----------------
;; sketchy 4gl-mode for gnu emacs
;; by Harry Bochner, copyright 1991
;; This code may be distributed freely, as long as this notice is not removed.

(defvar 4gl-mode-map ()
  "Keymap used in 4GL mode.")
(if 4gl-mode-map
    ()
  (setq 4gl-mode-map (make-sparse-keymap))
  (define-key 4gl-mode-map "\177" 'backward-delete-char-untabify)
  (define-key 4gl-mode-map "\t" '4gl-tab)
  (define-key 4gl-mode-map "\C-c\t" '4gl-unindent)
  (define-key 4gl-mode-map "\ej" '4gl-close-stat)
  )

(defvar 4gl-mode-abbrev-table nil
  "Abbrev table in use in 4gl-mode buffers.")
(define-abbrev-table '4gl-mode-abbrev-table '(
    ("repo" "report" nil 0)
    ("sele" "select" nil 0)
    ("func" "function" nil 0)
    ("def" "define" nil 0)
    ))

(defun 4gl-mode ()
  "Turn on 4GL mode."
  (interactive)
  (kill-all-local-variables)
  (use-local-map 4gl-mode-map)
  (setq local-abbrev-table 4gl-mode-abbrev-table)
  (make-local-variable 'indent-line-function)
  (setq indent-line-function '4gl-indent-line)
  (abbrev-mode -1)
  (setq major-mode '4gl-mode)
  (setq mode-name "4gl")
  (make-variable-buffer-local 'blink-matching-paren)
  (setq blink-matching-paren nil)
  (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 "#+ *")
)

(defun 4gl-line-type (extra)
  "Return the type number for the current 4gl line."
  (or (4gl-try-type extra)
      (4gl-try-type
       '(("main\\|function \\|report" 1 4)
	 ("case \\|for \\|foreach \\|if \\|while \\|else" 2 4)
	 ("call \\|end \\|clear \\|close \\|construct\\|continue" 2)
	 ("create\\|current\\|declare\\|define\\|delete\\|display" 2)
	 ("drop\\|error\\|execute\\|exit\\|fetch\\|finish\\|flush" 2)
	 ("globals\\|goto\\|initialize\\|input\\|insert\\|load" 2)
	 ("load\\|let \\|lock \\|menu \\|message\\|next \\|open\\|options" 2)
	 ("output\\|prepare\\|prompt\\|put \\|return \\|return$\\|run " 2)
	 ("scroll \\|select.*into\\|start \\|unload\\|unlock\\|update" 2)
	 ("validate\\|sleep " 2)
	 ("command" 1 0 (("menu" 1)))
	 ("then" 2 4 (("if " 2 2)))
	 ("when " 1 0 (("case" 1)))
	 ("after \\|before \\|on \\|page " 1 0 (("input\\|format" 1 4)))
	 ("select" 3)
	 ("where\\|from \\|array\\|struct\\|order\\|group \\|values\\|into" 4)
	 ("print\\|skip\\|need" 2)
	 ("format\\|output" 1 4)
	 ("page " 1)
	 ("" 10))))
  )

(defun 4gl-try-type (plist)
  "work down list of line types."
  (cond ((not plist) nil)
	((looking-at (car (car plist)))
	 (cdr (car plist)))
	(t (4gl-try-type (cdr plist)))))

(defun 4gl-note-match ()
  "Determine the construct this end matches, and note it."
  (forward-char 3)
  (skip-chars-forward " ")
  (let ((p (point)))
    (skip-chars-forward "a-z")
    (setq to-match (cons (buffer-substring p (point)) to-match)))
  (setq nesting (+ 1 nesting))
  )

(defun 4gl-balance-end ()
  "Find the construct matching this end, and return its indentation."
  (let ((nesting 0)
	(to-match nil))
    (cond ((looking-at "else")
	   (setq nesting 1
		 to-match '("if\\|then")))
	  (t (4gl-note-match)))
    (beginning-of-line)
    (while (and (> (point) (point-min))
		(> nesting 0))
      (backward-to-indentation 1)
      (cond ((looking-at "end ") (4gl-note-match))
	    ((looking-at (car to-match))
	     (setq to-match (cdr to-match)
		   nesting (- nesting 1))))
      (beginning-of-line))
    (current-indentation))
  )

(defun 4gl-calc-indent ()
  "Calculate appropriate indentation for this line based on previous line(s)."
  (backward-to-indentation 0)
  (let ((curpos (point))
	(ptype '(100))
	(curtype (4gl-line-type '(("$" 2)
				  ("end \\|else" 5))))
	cur-indent)
    (cond ((= (car curtype) 5)
	   (prog1 (4gl-balance-end) (goto-char curpos)))
	  (t
	   (while (> (car ptype) (car curtype))
	     (and (looking-at "end ") (4gl-balance-end))
	     (beginning-of-line)
	     (setq ptype
		   (cond ((= (point) (point-min)) '(0))
			 (t (backward-to-indentation 1)
			    (4gl-line-type (nth 2 curtype))))))
	   (setq cur-indent (current-indentation))
	   (and (nth 1 ptype)
		(setq cur-indent (+ cur-indent (nth 1 ptype))))
	   (prog1
	       (cond ((= (car curtype) (car ptype))
		      cur-indent)
		     ((looking-at ".*([^)]*$")
		      (skip-chars-forward "^(")
		      (+ 1 (current-column)))
		     ((looking-at "let.*=")
		      (skip-chars-forward "^=")
		      (+ 2 (current-column)))
		     ((= (car curtype) 10)
		      (forward-word 1)
		      (+ 1 (current-column)))
		     (t (+ 4 cur-indent)))
	     (goto-char curpos))))))

(defun 4gl-indent-line ()
  "Indent the current line as 4gl code."
  (beginning-of-line)
  (let ((beg (point)))
    (forward-to-indentation 0)
    (delete-region beg (point))
    (indent-to (4gl-calc-indent)))
  )

(defun 4gl-close-stat ()
  "Open a new line; if current line begins a statement,
insert the terminator for this statement, and indent further."
  (interactive)
  (let ((p (point)))
    (back-to-indentation)
    (or (4gl-try-stat
	   '("function" "if" "while" "main" "foreach" "for"
	     "menu" "input" "report" "globals" "record"))
	(and (goto-char p)
	     (newline-and-indent)))))

(defun 4gl-try-stat (syms)
  (cond ((not syms) nil)
	((looking-at (car syms))
	 (let ((x (current-indentation)))
	   (end-of-line)
	   (open-line 1)
	   (forward-char)
	   (indent-to x)
	   (insert "end " (car syms))
	   (beginning-of-line)
	   (open-line 1)
	   (and (= x 0)
		(setq x 4))
	   (indent-to (+ 4 x))
	   t))
	(t (4gl-try-stat (cdr syms)))))

(defun 4gl-tab ()
  "Reindent current line."
  (interactive)
  (let ((curpos (point))
	beg)
    (back-to-indentation)
    (setq beg (point))
    (4gl-indent-line)
    (and (> curpos beg)
	 (forward-char (- curpos beg))))
  )

(defun 4gl-unindent ()
  "Decrease the indentation of this line."
  (interactive)
  (let (x col)
    (back-to-indentation)
    (setq x (point))
    (setq col (current-column))
    (beginning-of-line)
    (delete-region (point) x)
    (setq col (- col 4))
    (indent-to col)))