;;; COBOL-Mode for various emacsen.
;;; Subject to the "Artistic License":
;;;   http://www.opensource.org/licenses/artistic-license.html

;;; Cobol-Mode for xemacs ("clomo")
;;; Version 0.2, Germany, '95, '96, '98
;;; by Azundris (xemacs adaption, font-lock et al.):
;;;   http://www.thepentagon.com/azundris/hacks/lisp/

;;; Cobol-Mode for GNU Emacs ("como")
;;; Version 1.0, Lueneburg, 1993/94
;;; by Andree Peters and Harald Weiss


;;; Disclaimer (I)
;;;
;;; Obviously, everything that happens while or because of using this mode
;;; is your fault, and your fault only, no warrantees given etc. -- we all
;;; know that.
;;; This mode was originally developed as "como (COBOL-mode)" for emacs-19
;;; by Andree Peters and Harald Weiss.  When they left the FH Lueneburg, I
;;; surprisingly inherited the project  even though I hate COBOL and am no
;;; wizardress when it comes to lisp. Due to this shortcoming, I was in no
;;; position to judge or even improve the code that was given to me.
;;;
;;;    http://www.lysator.liu.se/hackdict/split2/cobol.html
;;;    http://www.lysator.liu.se/hackdict/split2/emacs.html
;;;    http://www.lysator.liu.se/hackdict/split2/lisp.html
;;;    http://www.lysator.liu.se/hackdict/split2/c.html
;;;
;;;
;;; The Upshot.
;;;
;;; All these  things said,  you might  understand that  I feel I am in no
;;; position to make grand announcements of support. Clomo (with the "clo"
;;; deriving from the German "Klo" - "bog") comes on an as-is basis --- if
;;; you find a bug in it,  you can tell  us about  it,  but it is not very
;;; likely that you will ever see a fix for it.  If you _fix_ a bug in it,
;;; please mail it to us with a short description, we will probably add it
;;; to the mode for the benefit of the masses. Also, if I forgot any COBOL
;;; keywords, please let us know so they may be added to the font-lock.
;;; Finally,  I am aware of  the fact that  you get a lot of warnings when
;;; byte-compiling the file, most of which I ascribe to the changes in the
;;; way windows,  frames and menus are handled.  Please make sure that any
;;; changes  you make are either compatible with older emacsen or are only
;;; executed in those versions that they are known to work with.
;;;
;;; Thanks, Azundris <azundris@thepentagon.com>
;;;
;;;
;;; -------------------------------------------------------------------------
;;; If clomo is not automatically started when opening a file, try adding
;;; the following to your .emacs file:
;;;  (autoload 'cobol-mode "cobol")
;;;  (setq auto-mode-alist (cons '("\\.cbl\\'" . cobol-mode) auto-mode-alist)) 
;;; where 'cbl' is the file extension for cobol programs. 
;;; -------------------------------------------------------------------------
;;;
;;; History.
;;;
;;; 04/21/96 - font lock works                                           Azou
;;; 04/22/96 - code generator inserts program name in upper case
;;;            letters now in "S1-<prgname> SECTION".                    Azou
;;;          - code generator tries to make source HTML-compliant(!)     Azou
;;; 04/23/96 - generic compiler call                                     Azou
;;;            environment variable, description, defaults to
;;;            COMO_P,  switches for compiling a program,       "-xvP"
;;;            COMO_L,  switches for compiling a module,        "-xvcP"
;;;            COMO_C,  (path and) name for the compiler call,  "cob"
;;;            COMO_H,  remote server. *if* this is set, clomo  ""
;;;                     tries to "rsh" $COMO_C on the specified
;;;                     host. A "cd" to the current directory
;;;                     will be added to the remote command,
;;;                     assuming the file-system is similar
;;;                     (as in, NFS-mounted).
;;; 04/26/96 - fontifies HTML                                            Azou
;;;          - added five billion keywords                               Azou
;;; 04/30/96 - section hiding via outline mode                           Azou
;;;          - htmlifies source                                          Azou
;;;          - nassifies source (COBOL '74, anyway)                      Azou
;;; 05/06/96 - removes excess spaces and CRs at EOL                      Azou
;;;          - converts source to uppercase (for COBOL '74)              Azou
;;;            (NOTE: required for font-lock, nassi, html, outline)
;;;          - added trouble-shooting features for nassi-generator:      Azou
;;;            - optional debug output
;;;            - warnings 4 mismatching #s of (END-)IFs, -EVALs,
;;;              -PERFORMs, tries to brute-force correct LaTeX source
;;; 05/09/96 - minor bug fix: empty lines at EOF don't crash nassi now   Azou
;;;          - added column display                                      Azou
;;; 05/20/96 - outline mode on by default now                            Azou
;;;          - does folding on the web too if Roxen server is used       Azou
;;; 11/15/96 - new feature: remote compilation on NFS sytems.            Azou
;;;            see description of $COMO_H environment variable above.
;;; 03/24/99 - changed menus to use easy-menu (required for xemacs 20+)  Azou
;;; 08/15/00 - corrections enabling use under Emacs and on
;;;            Windows32 systems. '/' in col. 7 treated as comment.      JB
;;; ToDo     - make modules HTML-compliant as well                       ------

;;; -------------------------------------------------------------------------

;; Variables controlling fontification
;;
;;   Unfortunately, we need two sets of keywords:
;; - cobol-multi-keywords defines a list of keywords that have two or
;;   more separate words. These may not be matched against word-boundaries
;;   it seems because that way, only the last word would be highlighted.
;;   Theoretically, if any such keyword were to be a part of long word,
;;   the matching part in that word would highlight (try typing
;;   "MAKE-FILE SECTION." to see what I mean". Fortunately, those cases are
;;   rather rare.
;; - cobol-keywords contains a list of keywords that may be matched against
;;   word boundaries. We don't want "IS" to be highlighted in "MISMATCH SECTION."
;;   --Azou 4/96
;;
(defvar cobol-multi-keywords '( "CONFIGURATION SECTION"
			        "IDENTIFICATION DIVISION"
			        "ENVIRONMENT DIVISION"
			        "INPUT-OUTPUT SECTION"
			        "DATA DIVISION"
				"FILE SECTION"
				"PROCEDURE DIVISION" "SIZE ERROR"
				"STOP RUN"
				"EXIT PROGRAM"
				"WORKING-STORAGE SECTION"
				"NO REWIND" "AT END" )
  "COBOL-keywords consisting of more than one word. See cobol-keywords.")

(defvar cobol-keywords '(
	"ACCEPT" "ACCESS" "ADD" "ADVANCING" "AFTER" "ALL" "ALPHABETIC"
	"ALPHABETIC-LOWER" "ALPHABETIC-UPPER" "ALPHANUMERIC"
	"ALPHANUMERIC-EDITED" "ALPHATBETIC" "ALSO" "ALTER" "ALTERNATE" "AND"
	"ARE" "AREA" "AREAS" "ASCENDING" "ASSIGN" "AT" "AUTHOR"

	"BEFORE" "BINARY" "BLANK" "BLOCK" "BOTTOM" "BY"

	"CALL" "CANCEL" "CD" "CF" "CH" "CHANGED" "CHARACTER"
	"CHARACTERS" "CLOCK-UNITS" "CLOSE" "COBOL" "CODE" "CODE-SET"
	"COLLATING" "COLUMN" "COMMA" "COMMUNICATION" "COMP" "COMPUTATIONAL"
	"COMPUTE" "CONFIGURATION" "CONSOLE" "CONTAINS" "CONTINUE" "CONTROL"
	"CONTROLS" "CONVERTING" "COPY" "CORR" "CORRESPONDING"
	"COUNT" "CRT" "CURRENCY"

        "DATE-COMPILED" "DATE-WRITTEN" "DATE" "DAY" "DE"
	"DEBUG-CONTENTS" "DEBUG-ITEM" "DEBUG-LINE" "DEBUG-NAME"
	"DEBUG-SUB-1" "DEBUG-SUB-2" "DEBUG-SUB-3" "DEBUGGING"
	"DECIMAL-POINT" "DECLARATIVES" "DELETE" "DELIMITED" "DELIMITER"
	"DEPENDING" "DESCENDING" "DESTINATION" "DETAIL" "DISABLE" "DISPLAY"
	"DIVIDE" "DOWN" "DUPLICATES" "DYNAMIC"

	"EDI" "ELSE" "EMI" "ENABLE" "END-ADD" "END-CALL" "END-COMPUTE"
	"END-DELETE" "END-DIVIDE" "END-EVALUATE" "END-IF" "END-MULTIPLY"
	"END-OF-PAGE" "END-PERFORM" "END-READ" "END-RECEIVE" "END-RETURN"
	"END-REWRITE" "END-SEARCH" "END-START" "END-STRING" "END-SUBSTRACT"
	"END-UNSTRING" "END-WRITE" "ENTER" "ENVIRONMENT" "EOP" "EQUAL" "END"
	"ERROR" "ESI" "EVALUATE" "EVERY" "EXCEPTION" "EXHIBIT" "EXIT"
	"EXTEND"

	"FALSE" "!FD" "FILE-CONTROL" "FILE" "FILLER" "FINAL" "FIRST"
	"FOOTING" "FOR" "FROM"

	"GENERATE" "GIVING" "GLOBAL" "GO" "GREATER" "GROUP"

	"HEADING" "HIGH-VALUE" "HIGH-VALUES"

	"I-O" "I-O-CONTROL" "IF" "IN" "INDEX" "INDEXED" "INITIALIZE"
	"INDICATE" "INITIAL" "INITIATE" "INPUT" "INPUT-OUTPUT" "INSPECT"
	"INSTALLATION" "INTO" "INVALID" "IS"

	"JUST" "JUSTIFIED"

	"KEY"

	"LABEL" "LAST" "LEADING" "LEFT" "LENGTH" "LESS" "LIMIT" "LIMITS"
	"LINAGE" "LINAGE-COUNTER" "LINE" "LINE-COUNTER" "LINES" "LINKAGE"
	"LOCK" "LOW-VALUE" "LOW-VALUES"

	"MEMORY" "MERGE" "MESSAGE" "MODE" "MODULES" "MOVE" "MULTIPLE"
	"MULTIPLY"

	"NAMED" "NATIVE" "NEGATIVE" "NEXT" "NO" "NOT" "NUMBER" "NUMERIC"

	"OBJECT-COMPUTER" "OCCURS" "OF" "OFF" "OMITTED" "ON" "OPEN"
	"OPTIONAL" "OR" "ORGANIZATION" "OUTPUT" "OVERFLOW"

	"PAGE" "PAGE-COUNTER" "PERFORM" "PF" "PH" "PIC" "PICTURE" "PICTURES"
	"PLUS" "POINTER" "POSITION" "POSITIVE" "PRINTING" "PROCEDURE"
	"PROCEDURES" "PROCEED" "PROGRAM-ID"

	"QUEUE" "QUOTE" "QUOTES"

	"RANDOM" "RD" "READ" "RECEIVE" "RECORD" "RECORDS" "REDEFINES" "REEL"
	"REFERENCES" "RELATIVE" "RELEASE" "REMAINDER" "REMOVAL" "RENAMES"
	"REPLACING" "REPORT" "REPORTING" "REPORTS" "RERUN" "RESERVE" "RESET"
	"RETURN" "REVERSED" "REWIND" "REWRITE" "RF" "RH" "RIGHT" "ROUNDED"
	"RUN"

	"SAME" "!SD" "SEARCH" "SECURITY" "SEGMENT" "SEGMENT-LIMIT"
	"SELECT" "SEND" "SENTENCE" "SEPARATE" "SEQUENCE" "SEQUENTIAL" "SET"
	"SIGN" "SIZE" "SORT" "SORT-MERGE" "SOURCE-COMPUTER"
	"SPACE" "SPACES" "SPECIAL-NAMES" "STANDARD" "STANDARD-1" "START"
	"STATUS" "STOP" "STRING" "SUB-QUEUE-1" "SUB-QUEUE-2" "SUB-QUEUE-3"
	"SUBTRACT" "SUM" "SUPPRESS" "SYMBOLIC" "SYNC" "SYNCHRONIZED"

	"TABLE" "TALLYING" "TAPE" "TERMINAL" "TERMINATE" "TEST" "TEXT"
	"THAN" "THEN" "THROUGH" "THRU" "TIME" "TIMES" "TO" "TOP" "TRAILING"
	"TYPE"

	"UNIT" "UNSTRING" "UNTIL" "UP" "UPON" "USAGE" "USE" "USING"

	"VALUE" "VALUES" "VARYING"

	"WHEN" "WITH" "WORDS" "WRITE"

	"ZERO" "ZEROES" "ZEROS"
	)
  "COBOL-keywords. Single words only. See cobol-multi-keywords.")

(defvar cobol-hilite-lowercase 0
  "*Fontify lowercase (COBOL 85) or uppercase (COBOL 74) keywords.")


;; Make compiling generic. Defines three new environment variables. s/a
;; --Azou 4/96
(defvar cobol-mode-compiler-name (or (getenv "COMO_C") "cob")
  "*The (path and) name for the compiler call.")
(defvar cobol-mode-compile-host (or (getenv "COMO_H") "rzserv2")
  "*The host to compile on. An empty string denotes local compilaton.")
(defvar cobol-mode-prog-switches (or (getenv "COMO_P") "-xvP")
  "*The switches for compiling a COBOL-program.")
(defvar cobol-mode-lib-switches (or (getenv "COMO_L") "-xcvP")
  "*The switches for compiling a COBOL-library.")



;; For auto-nassiing

(defvar cobol-nassi-include-warnings 1
  "*Switch including of warnings (0/1).")
(defvar cobol-nassi-include-debug 1
  "*Switch including of debug/analysis information (0/1).")
(defvar cobol-nassi-include-commands 0
  "*Switch including of paragraphs (0/1).")
(defvar cobol-nassi-indent 1
  "The current indent for nassification :-)")
(defvar cobol-nassi-whiles 0
  "Number of pending WHILEs")
(defvar cobol-nassi-ifs 0
  "Number of pending IFs")
(defvar cobol-nassi-evals 0
  "Number of pending EVALs")
(defvar cobol-nassi-latex-line-counter 0
  "Line counter for output lines")
(defvar cobol-nassi-debug-line-counter 0
  "Line counter for debug lines")
(defconst cobol-nassi-head
  (concat
   "\\documentstyle[nassi,12pt]{article}\n"
   "\\addtolength{\\topmargin}{-4.5cm}\n"
   "\\addtolength{\\oddsidemargin}{-3cm}\n"
   "\\addtolength{\\evensidemargin}{-3cm}\n"
   "\\addtolength{\\textwidth}{4cm}\n"
   "\\begin{document}\n"
   "  \\nassiwidth=16cm\n"
   "  \\footnotesize\n")
  "*The header for auto-generated LaTeX Nassi style sources.")
(defconst cobol-nassi-sub-head "  \\centerline{\\protect{\\STRUCT{{\\tt ")
(defconst cobol-nassi-foo   "}}{")
(defconst cobol-nassi-bar   "}{%\n")
(defconst cobol-nassi-sub-foot  "    }%\n  }}\n")
(defconst cobol-nassi-foot
  (concat
   "  \\normalsize\n"
   "\\end{document}\n%\n%\n"
   "% generated by ClOMO (xemacs cobol-mode) by Azundris,\n"
   "% thanks to Stefan Manzke and Markus Grombein for help with\n"
   "% LaTeX Nassi mode.\n" )
  "*The footer for auto-generated LaTeX Nassi style sources.")


(defconst cobol-cc-keywords
  '( "GREATER" "LESS" "THAN" "EQUAL" "UNEQUAL" "TO"
     "=" "<" ">" "<>" "<=" "=<" ">=" "=>" "AND" "OR"
     "NOT" "IS" "ANY" "THRU" "THROUGH" "ALSO" "OTHER"
     "TRUE" "FALSE" "(" ")")
  "Contains list of words that may occur in COBOL-condition codes.")

(defconst cobol-cc-regexp
  (concat
   "\\(\\<" (mapconcat 'identity cobol-cc-keywords "\\>\\|\\<")
   "\\>\\|\\<-?[0-9]+\\>\\)")
  "Contains list of reg-exps describing what may occur in COBOL-condition codes.")

(defconst cobol-cc-not
  (concat
	      "\\( "
	      (mapconcat 'identity cobol-multi-keywords "\\|")
	      "\\)\\|\\(\\<"
	      (mapconcat 'identity cobol-keywords "\\>\\|\\<")
	      "\\>\\)")
 "Keywords that do NOT belong to conditions. Needed to figure out variables.")


;; Const controlling auto-outlining
;; levels must sorted in reverse oda  --Azou 4/96
(defconst cobol-struct-list
  (list
   '("[ ]+01 " 4)
   '("\\(FD[ \t\\.]\\|SD[ \t\\.]\\|01[ \t\\.]\\|\\([-_A-Za-z0-9]*\\.\\)\\)" 3)
   '("[-_A-Za-z0-9]+ SECTION\\.$" 2)
   '("[-_A-Za-z]+ DIVISION\\.$" 1))
  "List of reg-exps describing structuring lines of a COBOL-source.")

(defvar outline-regexp "^[1\^L]+ "
  "Regular expression to match the beginning of a heading.
Any line whose beginning matches this regexp is considered to start a heading.
The recommended way to set this is with a Local Variables: list
in the file it applies to.  See also outline-heading-end-regexp.")


(defvar cobol-azou-flag 0
  "Prevents the start-up image from appearing more than once")


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

(defconst cobol-program-id "PROGRAM-ID.")
(defconst cobol-section " SECTION.")
(defconst cobol-file-section " FILE SECTION")
(defconst cobol-sequential "sequential")
(defconst cobol-upper-sequential "SEQUENTIAL")
(defconst cobol-indexed "indexed")
(defconst cobol-upper-indexed "INDEXED")
(defconst cobol-relative "relative")
(defconst cobol-upper-relative "RELATIVE")
(defconst cobol-random "random")
(defconst cobol-upper-random "RANDOM")
(defconst cobol-dynamic "dynamic")
(defconst cobol-upper-dynamic "DYNAMIC")
(defconst cobol-working-storage-section "WORKING-STORAGE SECTION")
(defconst cobol-linkage-section "LINKAGE SECTION.")
(defconst cobol-procedure-division "PROCEDURE DIVISION")
(defconst cobol-procedure-division-using "PROCEDURE DIVISION USING")
(defconst cobol-k-programid " K-PROGRAMID")
(defconst cobol-value "VALUE")
(defconst cobol-string-author "AUTHOR.")
(defconst cobol-string-date-written "DATE-WRITTEN.")
(defconst cobol-k-autorid " K-AUTORID")
(defconst cobol-display "DISPLAY")
(defconst cobol-if " IF")
(defconst cobol-then " THEN")
(defconst cobol-else " ELSE")
(defconst cobol-perform-until " PERFORM[a-z ]*UNTIL")
(defconst cobol-perform "PERFORM")
(defconst cobol-until "UNTIL")
(defconst cobol-perform-test-after " TEST AFTER")
(defconst cobol-evaluate " EVALUATE")
(defconst cobol-end-evaluate " END-EVALUATE")
(defconst cobol-when " WHEN")
(defconst cobol-at-end "  AT END")
(defconst cobol-invalid "  INVALID")
(defconst cobol-not-at-end " NOT AT END")
(defconst cobol-not-invalid " NOT INVALID")
(defconst cobol-on-size-error "  ON SIZE ERROR")
(defconst cobol-not-on-size-error " NOT ON SIZE ERROR")
(defconst cobol-end " END-[a-z]*")
(defconst cobol-end-if " END-IF")
(defconst cobol-end-perform " END-PERFORM")
(defconst cobol-call "CALL")
(defconst cobol-read " READ")
(defconst cobol-end-read " END-READ")
(defconst cobol-arrowl "*<----")
(defconst cobol-arrowr "*---->")
(defconst cobol-begin " ANFANG.")
(defconst cobol-string-title "COBOL-Source: ")         ;; azou 4/96
(defconst cobol-string-start-region "<!-- SOURCE -->") ;; azou 4/96
(defconst cobol-string-end-region "<!-- /SOURCE -->")  ;; azou 4/96
(defconst cobol-string-end-index "<!-- /INDEX -->")    ;; azou 4/96
(defconst cobol-string-auto-name "9     ")             ;; azou 4/96

(defvar cobol-mode-syntax-table nil
"Syntax table in use in cobol-mode buffers.")

(defvar cobol-mode-map ()
"Keymap used in cobol-mode.")

(defvar cobol-column-display
  (concat "1     7    12      20        30        40        50        60        70 \n"
	  "      *    |       |         |         |         |         |         |\n")
 "String displayed above current line by \\[cobol-column-display].")

(defvar cobol-html-head
  (concat"<HTML>*<HEAD><TITLE>COBOL-Source: </TITLE></HEAD><BODY TEXT=\"dddddd\" LINK=\"ffffff\" BGCOLOR=\"000000\" VLINK=\"aaaaaa\"><H1>COBOL-Source: </H1><PRE>\n"
         "      *COBOL-source edited with clomo on xemacs; clomo (c) 1996 by\n"
	 "      *FH NON/FBW and <A HREF=\"http://www.thepentagon.com/azundris\">Azundris</A> based on cobol mode for emacs19\n"
	 "      *by Andree Peters and Harald Weiss\n"
	 "      ******************************************************************\n"
	 "      *" cobol-string-start-region "\n"))

(defvar cobol-html-foot
  (concat"      *" cobol-string-end-region "\n      *"
	           cobol-string-end-index "</BODY></HTML>\n"))

(defvar cobol-PrgFrame
  ;; Don't insert a HTML header here, it freaks out open-cobol and makes (gnu) emacs think it's dealing with an HTML file: ugly -- theBlackDragon 19/07/2005
 ;; (concat cobol-html-head
  (concat
	 "       IDENTIFICATION DIVISION.\n"
	 "       PROGRAM-ID.\n       AUTHOR.\n"
         ;; "       INSTALLATION.\n"
	 ;; "           FH? NON!  D-21339 LUENEBURG.\n"
	 "       DATE-WRITTEN.\n"
	 "      ******************************************************************\n"
	 "       ENVIRONMENT DIVISION.\n       CONFIGURATION SECTION.\n"
	 ;; "       SOURCE-COMPUTER.\n           ~.\n"
	 ;; "       OBJECT-COMPUTER.\n           ~.\n"
	 "       SPECIAL-NAMES.\n"
	 ;; "           CONSOLE IS CRT\n"
	 "           DECIMAL-POINT IS COMMA.\n"
	 "       INPUT-OUTPUT SECTION.\n       FILE-CONTROL.\n\n"
	 "      ******************************************************************\n"
	 "       DATA DIVISION.\n       FILE SECTION.\n\n"
	 "      ******************************************************************\n"
	 "       WORKING-STORAGE SECTION.\n       01  K-ID-BER.\n"
	 "           05  K-PROGRAMID   PIC X()     VALUE \"\".\n"
	 "           05  K-AUTORID     PIC X()     VALUE \"\".\n"
	 "      ******************************************************************\n"
	 "       PROCEDURE DIVISION.\n"))

(defvar cobol-SubprgFrame
  (concat"      ******************************************************************\n"
	 "       IDENTIFICATION DIVISION.\n       PROGRAM-ID.\n"
	 "       AUTHOR.\n"
	 ;; "       INSTALLATION.\n"
	 ;; "           FH-NORDOSTNIEDERSACHSEN D-21339 LUENEBURG.\n"
	 "       DATE-WRITTEN.\n"
	 "      ******************************************************************\n"
	 "       ENVIRONMENT DIVISION.\n       CONFIGURATION SECTION.\n"
	 ;; "       SOURCE-COMPUTER.\n           ~.\n"
	 ;; "       OBJECT-COMPUTER.\n           ~.\n"
	 "       SPECIAL-NAMES.\n"
	 ;; "           CONSOLE IS CRT\n"
	 "           DECIMAL-POINT IS COMMA.\n       INPUT-OUTPUT SECTION.\n"
	 "       FILE-CONTROL.\n\n"
	 "      ******************************************************************\n"
	 "       DATA DIVISION.\n       FILE SECTION.\n\n"
	 "      ******************************************************************\n"
	 "       WORKING-STORAGE SECTION.\n\n"
	 "      ******************************************************************\n"
	 "       LINKAGE SECTION.\n\n"
	 "      ******************************************************************\n"
         "       PROCEDURE DIVISION.\n"))

(if cobol-mode-syntax-table ()
(setq cobol-mode-syntax-table (make-syntax-table))
;  (modify-syntax-entry ?*  "<" cobol-mode-syntax-table)
;  (modify-syntax-entry ?\n ">" cobol-mode-syntax-table)
  ;; Give CR the same syntax as newline, for selective-display
;  (modify-syntax-entry ?\^m ">" cobol-mode-syntax-table)
  (modify-syntax-entry ?\;  "w" cobol-mode-syntax-table)
; (modify-syntax-entry ?-  "." cobol-mode-syntax-table)
  (modify-syntax-entry ?-  "w" cobol-mode-syntax-table)
  (modify-syntax-entry ?. " " cobol-mode-syntax-table)
 )

(if cobol-mode-map ()
  (setq cobol-mode-map (make-sparse-keymap))
  (define-key cobol-mode-map ";" 'cobol-abbrev-begin)
  (define-key cobol-mode-map "\e\C-i\C-f" 'cobol-insert-if)
  (define-key cobol-mode-map "\r" 'cobol-return)
  (define-key cobol-mode-map "\e\C-p\C-u" 'cobol-insert-perform-until)
  (define-key cobol-mode-map "\e\C-p\C-t" 'cobol-insert-perform-test-after)
  (define-key cobol-mode-map "\e\C-e\C-v" 'cobol-insert-evaluate)
  (define-key cobol-mode-map "\e\C-c\C-d" 'cobol-column-display)
  (define-key cobol-mode-map "\e\C-a\C-c" 'cobol-add-comment)
  (define-key cobol-mode-map "\e\C-r\C-k" 'cobol-insert-read-key)
  (define-key cobol-mode-map "\e\C-a\C-p" 'cobol-add-paragraph)
  (define-key cobol-mode-map "\e\C-f\C-c" 'cobol-file-control)
  (define-key cobol-mode-map "\t" 	  'cobol-indent-cursor)
  (define-key cobol-mode-map "\e\C-c\C-t" 'cobol-consistence-variable)
  (define-key cobol-mode-map "\e\C-l\C-v" 'cobol-list-variable)
  (define-key cobol-mode-map "\e\C-ch"    'cobol-htmlify-source)   ;;--azou 4/96
  (define-key cobol-mode-map "\e\C-co"    'cobol-outline-source)   ;;--azou 4/96
  (define-key cobol-mode-map "\e\C-cn"    'cobol-nassify-source)   ;;--azou 4/96
  (define-key cobol-mode-map "\e\C-cu"    'cobol-uppercase-source) ;;--azou 4/96
  (define-key cobol-mode-map "\e\C-cr"    'cobol-remove-xs-spaces) ;;--azou 4/96
  (define-key cobol-mode-map "\e\C-cs"    'cobol-spinnerize-source);;--azou 5/96
  (define-key cobol-mode-map "\e\C-a\C-v" 'cobol-add-variable)
  (define-key cobol-mode-map "\e\C-d\C-v" 'cobol-declare-variable)
  (define-key cobol-mode-map "\e\C-c\C-v" 'cobol-complete-variable)
  (define-key cobol-mode-map "\e\C-c\C-a" 'cobol-call)
  (define-key cobol-mode-map "\e\C-r\C-n" 'cobol-insert-read-next)
  (define-key cobol-mode-map "\e\C-e\C-c" 'cobol-exit-checkin)
  (define-key cobol-mode-map "\e\C-s\C-v" 'cobol-show-versions)
  (define-key cobol-mode-map "\e\C-f\C-e" 'cobol-find-errors)
  (define-key cobol-mode-map "\e\C-n\C-e" 'cobol-next-error)
  (define-key cobol-mode-map "\e\C-p\C-e" 'cobol-previous-error)
  (define-key cobol-mode-map "\e\C-c\C-c" 'cobol-compiler-call)
  (define-key cobol-mode-map "\e\C-a\C-d" 'cobol-add-add)
  (define-key cobol-mode-map "\e\C-d\C-i" 'cobol-add-divide)
  (define-key cobol-mode-map "\e\C-c\C-g" 'cobol-add-compute)
  (define-key cobol-mode-map "\e\C-s\C-u" 'cobol-add-subtract)
  (define-key cobol-mode-map "\e\C-m\C-u" 'cobol-add-multiply)
  (define-key cobol-mode-map "\e\C-r\C-e" 'cobol-add-rewrite)
  (define-key cobol-mode-map "\e\C-w\C-r" 'cobol-add-write)
  (define-key cobol-mode-map "\e\C-s\C-t" 'cobol-add-start)
  (define-key cobol-mode-map "\e\C-d\C-e" 'cobol-add-delete)
  (define-key cobol-mode-map "\e\C-c\C-p" 'cobol-corresponding-construct))

					;RBX


(if (or (string= "x" window-system )
	(string= "w32" window-system )
	(string= "mswindows" window-system ))
    (progn
      (if (string-match "XEmacs\\|Lucid" emacs-version)
	  (progn
	     (easy-menu-define clomo-menubar cobol-mode-map "Menu for COBOL major mode"
;	       (purecopy-menubar
		(list
		 (assoc "File" default-menubar)
;					;	(append
		 (assoc "Edit" default-menubar)
		 (assoc "Apps" default-menubar)
		 (assoc "Options" default-menubar)
		 (assoc "Buffers" default-menubar)
		 (assoc "Tools" default-menubar)
		 '("Development"
	   ["Compiler call"		cobol-compiler-call  		t]
	   ["Find errors" 		cobol-find-errors		t]
	   ["Next error" 		cobol-next-error		t]
	   ["Previous error" 		cobol-previous-error		t]
	   ["Restart COBOL-mode"	cobol-reload-mode		t]
	   "---"
;;	 '("RCS"
	   ["Show version" 		cobol-show-versions 		t]
	   ["Checkin & Exit " 		cobol-exit-checkin		t]
	   "---"
;;	 '("Analyse"
	   ["Consistency of variables" 	cobol-consistence-variable	t]
	   ["Column display" 		cobol-column-display		t]
	   ["Show declaration" 		cobol-list-variable		t]
	   ["Complete and insert variable" cobol-complete-variable	t]
	   ["Corresponding construct" 	cobol-corresponding-construct	t]
	   "---"
	   ["Remove  spaces"            cobol-remove-xs-spaces          t]
	   ["ToUpper source"            cobol-uppercase-source          t]
	   ["HTMLify source"            cobol-htmlify-source            t]
	   ["SPLMify source"            cobol-spinnerize-source         t]
	   ["Outline source"            cobol-outline-source            t]
	   ["Nassify source"            cobol-nassify-source            t]
;;	   ["- Include commands"        cobol-nassi-cmd-toggle     :style toggle :selected (= cobol-nassi-include-commands 1)]
	   ["- Include warnings"        cobol-nassi-warning-toggle :style toggle :selected (= cobol-nassi-include-warnings 1)]
	   ["- Include debug info"      cobol-nassi-debug-toggle   :style toggle :selected (= cobol-nassi-include-debug 1)]
	   ["Highlight COBOL-74"        cobol-hilite-toggle        :style toggle :selected (= cobol-hilite-lowercase 0)]
	   )
	 '("Insert"
	   ["New subprogram" 		cobol-call			t]
	   ["Add paragraph or section" 	cobol-add-paragraph		t]
	   ["Add comment" 		cobol-add-comment		t]
	   ["FILE-CONTROL entry "	cobol-file-control		t]
	   "---"
	   ["Add variable"  		cobol-add-variable		t]
	   ["Declare variable" 		cobol-declare-variable		t]
	   "---"
	   ["COMPUTE" 		       	cobol-add-compute		t]
	   ["DIVIDE" 			cobol-add-divide		t]
	   ["MULTIPLY" 			cobol-add-multiply		t]
	   ["SUBTRACT" 			cobol-add-subtract		t]
	   ["ADD" 	      		cobol-add-add			t]
	   "---"
	   ["START "  			cobol-add-start			t]
	   ["DELETE "  			cobol-add-delete		t]
	   ["REWRITE " 			cobol-add-rewrite		t]
	   ["WRITE " 			cobol-add-write			t]
	   ["READ-NEXT "      	     	cobol-insert-read-next		t]
	   ["READ-KEY " 		cobol-insert-read-key		t]
	   "---"
	   ["EVALUATE TRUE"  		cobol-insert-evaluate		t]
	   ["PERFORM TEST AFTER UNTIL" 	cobol-insert-perform-test-after t]
	   ["PERFORM UNTIL" 		cobol-insert-perform-until	t]
	   ["IF-THEN-ELSE"  		cobol-insert-if			t]
	   )
	 nil
	 (assoc "Help" default-menubar)
	 ))
;)

;      (set-menubar clomo-menubar)
;      (add-menu-button '("Help") ["About ClOMO..." cobol-show-gorgeous t] "About XEmacs...")
;      (set-menubar-dirty-flag)
      )

    (progn
      (modify-frame-parameters (selected-frame) '((menue-bar-lines . 4)))

      (define-key cobol-mode-map [menu-bar compiler]
	(cons "Compiler" (make-sparse-keymap "Compiler")))
      (define-key cobol-mode-map
	[menu-bar compiler compiling]
	'("Compiler call" . cobol-compiler-call))
      (define-key cobol-mode-map
	[menu-bar compiler find-errors]
	'("Find errors" . cobol-find-errors))
      (define-key cobol-mode-map
	[menu-bar compiler next-error]
	'("Next error" . cobol-next-error))
      (define-key cobol-mode-map
	[menu-bar compiler previous-error]
	'("Previous error" . cobol-previous-error))

      (modify-frame-parameters (selected-frame) '((menue-bar-lines . 4)))

      (define-key cobol-mode-map [menu-bar analyse]
	(cons "Analyse" (make-sparse-keymap "Analyse")))
      (define-key cobol-mode-map
	[menu-bar analyse consistence-variable]
	'("Consistence of variables" . cobol-consistence-variable))
      (define-key cobol-mode-map
	[menu-bar analyse column-display]
	'("Column display" . cobol-column-display))
      (define-key cobol-mode-map
	[menu-bar analyse list-variable]
	'("Show declaration" . cobol-list-variable))
      (define-key cobol-mode-map
	[menu-bar analyse complete-variable]
	'("Complete and insert variable " . cobol-complete-variable))
      (define-key cobol-mode-map
	[menu-bar analyse corresponding-construct]
	'("Corresponding construct" . cobol-corresponding-construct))

      (modify-frame-parameters (selected-frame) '((menue-bar-lines . 2)))

      (define-key cobol-mode-map [menu-bar rcs]
	(cons "RCS" (make-sparse-keymap "RCS")))
      (define-key cobol-mode-map
	[menu-bar rcs show-version]
	'("Show version" . cobol-show-versions))
      (define-key cobol-mode-map
	[menu-bar rcs exit-checkin]
	'("Checkin & Exit " . cobol-exit-checkin))

      (modify-frame-parameters (selected-frame) '((menue-bar-lines . 19)))

      (define-key cobol-mode-map [menu-bar insert]
	(cons "Insert" (make-sparse-keymap "Insert")))
      (define-key cobol-mode-map
	[menu-bar insert call]
	'("New subprogram" . cobol-call))
      (define-key cobol-mode-map
	[menu-bar insert compute]
	'("COMPUTE" . cobol-add-compute))
      (define-key cobol-mode-map
	[menu-bar insert divide]
	'("DIVIDE" . cobol-add-divide))
      (define-key cobol-mode-map
	[menu-bar insert multiply]
	'("MULTIPLY" . cobol-add-multiply))
      (define-key cobol-mode-map
	[menu-bar insert subtract]
	'("SUBTRACT" . cobol-add-subtract))
      (define-key cobol-mode-map
	[menu-bar insert add]
	'("ADD" . cobol-add-add))
      (define-key cobol-mode-map
	[menu-bar insert start]
	'("START " . cobol-add-start))
      (define-key cobol-mode-map
	[menu-bar insert delete]
	'("DELETE " . cobol-add-delete))
      (define-key cobol-mode-map
	[menu-bar insert rewrite]
	'("REWRITE " . cobol-add-rewrite))
      (define-key cobol-mode-map
	[menu-bar insert write]
	'("WRITE " . cobol-add-write))
      (define-key cobol-mode-map
	[menu-bar insert read-next]
	'("READ-NEXT " . cobol-insert-read-next))
      (define-key cobol-mode-map
	[menu-bar insert read-key]
	'("READ-KEY " . cobol-insert-read-key))
      (define-key cobol-mode-map
	[menu-bar insert evaluate]
	'("EVALUATE TRUE" . cobol-insert-evaluate))
      (define-key cobol-mode-map
	[menu-bar insert perform-test-after]
	'("PERFORM TEST AFTER UNTIL" . cobol-insert-perform-test-after))
      (define-key cobol-mode-map
	[menu-bar insert perform-until]
	'("PERFORM UNTIL" . cobol-insert-perform-until))
      (define-key cobol-mode-map
	[menu-bar insert if]
	'("IF-THEN-ELSE" . cobol-insert-if))
      (define-key cobol-mode-map
	[menu-bar insert add-variable]
	'("Add variable" . cobol-add-variable))
      (define-key cobol-mode-map
	[menu-bar insert declare-variable]
	'("Declare variable" . cobol-declare-variable))
      (define-key cobol-mode-map
	[menu-bar insert add-comment]
	'("Add comment" . cobol-add-comment))
      (define-key cobol-mode-map
	[menu-bar insert paragraph]
	'("Add paragraph or section" . cobol-add-paragraph))
      (define-key cobol-mode-map
	[menu-bar insert file-control]
	'("FILE-CONTROL entry " . cobol-file-control))))))





(defvar cobol-mode-abbrev-table nil
  "Abbrev table in use in cobol-mode buffers.")

(if cobol-mode-abbrev-table
     ()
  (define-abbrev-table 'cobol-mode-abbrev-table ())
  (let ((abbrevs-changed nil))
    (define-abbrev cobol-mode-abbrev-table ";ac"   "ACCEPT" nil)
    (define-abbrev cobol-mode-abbrev-table ";ad"   "ADVANCING" nil)
    (define-abbrev cobol-mode-abbrev-table ";a"    "AFTER" nil)
    (define-abbrev cobol-mode-abbrev-table ";al"   "ALPHABETIC" nil)
    (define-abbrev cobol-mode-abbrev-table ";all"  "ALPHABETIC-LOWER" nil)
    (define-abbrev cobol-mode-abbrev-table ";alu"  "ALPHABETIC-UPPER" nil)
    (define-abbrev cobol-mode-abbrev-table ";aln"  "ALPHANUMERIC" nil)
    (define-abbrev cobol-mode-abbrev-table ";alne" "ALPHANUMERIC-EDITED" nil)
    (define-abbrev cobol-mode-abbrev-table ";at"   "ALTERNATE" nil)
    (define-abbrev cobol-mode-abbrev-table ";asc"   "ASCENDING" nil)
    (define-abbrev cobol-mode-abbrev-table ";as"   "ASSIGN" nil)
    (define-abbrev cobol-mode-abbrev-table ";b"    "BEFORE" nil)
    (define-abbrev cobol-mode-abbrev-table ";bi"   "BINARY" nil)
    (define-abbrev cobol-mode-abbrev-table ";bo"   "BOTTOM" nil)
    (define-abbrev cobol-mode-abbrev-table ";c"    "CALL" nil)
    (define-abbrev cobol-mode-abbrev-table ";ca"   "CANCEL" nil)
    (define-abbrev cobol-mode-abbrev-table ";ch"   "CHARACTER" nil)
    (define-abbrev cobol-mode-abbrev-table ";cu"   "CLOCK-UNITS" nil)
    (define-abbrev cobol-mode-abbrev-table ";cl"   "CLOSE" nil)
    (define-abbrev cobol-mode-abbrev-table ";cs"   "CODE-SET" nil)
    (define-abbrev cobol-mode-abbrev-table ";co"   "COLLATING" nil)
    (define-abbrev cobol-mode-abbrev-table ";cc"   "COMMUNICATION" nil)
    (define-abbrev cobol-mode-abbrev-table ";com"  "COMPUTATIONAL" nil)
    (define-abbrev cobol-mode-abbrev-table ";cp"   "COMPUTE" nil)
    (define-abbrev cobol-mode-abbrev-table ";cf"   "CONFIGURATION" nil)
    (define-abbrev cobol-mode-abbrev-table ";ct"   "CONTAINS" nil)
    (define-abbrev cobol-mode-abbrev-table ";con"  "CONTINUE" nil)
    (define-abbrev cobol-mode-abbrev-table ";ctr"  "CONTROL" nil)
    (define-abbrev cobol-mode-abbrev-table ";cv"   "CONVERTING" nil)
    (define-abbrev cobol-mode-abbrev-table ";cor"  "CORRESPONDING" nil)
    (define-abbrev cobol-mode-abbrev-table ";cur"  "CURRENCY" nil)
    (define-abbrev cobol-mode-abbrev-table ";dc"   "DATE-COMPILED" nil)
    (define-abbrev cobol-mode-abbrev-table ";dw"   "DATE-WRITTEN" nil)
    (define-abbrev cobol-mode-abbrev-table ";de"   "DEBUGGING" nil)
    (define-abbrev cobol-mode-abbrev-table ";dp"   "DECIMAL-POINT" nil)
    (define-abbrev cobol-mode-abbrev-table ";dec"  "DECLARATIVES" nil)
    (define-abbrev cobol-mode-abbrev-table ";del"  "DELETE" nil)
    (define-abbrev cobol-mode-abbrev-table ";det"  "DELIMITED" nil)
    (define-abbrev cobol-mode-abbrev-table ";dep"  "DEPENDING" nil)
    (define-abbrev cobol-mode-abbrev-table ";des"  "DESCENDING" nil)
    (define-abbrev cobol-mode-abbrev-table ";den"  "DESTINATION" nil)
    (define-abbrev cobol-mode-abbrev-table ";dis"  "DISPLAY" nil)
    (define-abbrev cobol-mode-abbrev-table ";di"   "DIVIDE" nil)
    (define-abbrev cobol-mode-abbrev-table ";div"  "DIVISION" nil)
    (define-abbrev cobol-mode-abbrev-table ";du"   "DUPLICATES" nil)
    (define-abbrev cobol-mode-abbrev-table ";dy"   "DYNAMIC" nil)
    (define-abbrev cobol-mode-abbrev-table ";e"    "ELSE" nil)
    (define-abbrev cobol-mode-abbrev-table ";en"   "ENABLE" nil)
    (define-abbrev cobol-mode-abbrev-table ";ea"   "END-ADD" nil)
    (define-abbrev cobol-mode-abbrev-table ";ec"   "END-CALL" nil)
    (define-abbrev cobol-mode-abbrev-table ";eco"  "END-COMPUTE" nil)
    (define-abbrev cobol-mode-abbrev-table ";ed"   "END-DELETE" nil)
    (define-abbrev cobol-mode-abbrev-table ";edi"  "END-DIVIDE" nil)
    (define-abbrev cobol-mode-abbrev-table ";ee"   "END-EVALUATE" nil)
    (define-abbrev cobol-mode-abbrev-table ";ei"   "END-IF" nil)
    (define-abbrev cobol-mode-abbrev-table ";em"   "END-MULTIPLY" nil)
    (define-abbrev cobol-mode-abbrev-table ";eop"  "END-OF-PAGE" nil)
    (define-abbrev cobol-mode-abbrev-table ";ep"   "END-PERFORM" nil)
    (define-abbrev cobol-mode-abbrev-table ";er"   "END-READ" nil)
    (define-abbrev cobol-mode-abbrev-table ";erc"  "END-RECEIVE" nil)
    (define-abbrev cobol-mode-abbrev-table ";ert"  "END-RETURN" nil)
    (define-abbrev cobol-mode-abbrev-table ";erw"  "END-REWRITE" nil)
    (define-abbrev cobol-mode-abbrev-table ";es"   "END-SEARCH" nil)
    (define-abbrev cobol-mode-abbrev-table ";est"  "END-START" nil)
    (define-abbrev cobol-mode-abbrev-table ";esr"  "END-STRING" nil)
    (define-abbrev cobol-mode-abbrev-table ";esu"  "END-SUBSTRACT" nil)
    (define-abbrev cobol-mode-abbrev-table ";eu"   "END-UNSTRING" nil)
    (define-abbrev cobol-mode-abbrev-table ";ew"   "END-WRITE" nil)
    (define-abbrev cobol-mode-abbrev-table ";env"  "ENVIRONMENT" nil)
    (define-abbrev cobol-mode-abbrev-table ";ev"   "EVALUATE" nil)
    (define-abbrev cobol-mode-abbrev-table ";ex"   "EXCEPTION" nil)
    (define-abbrev cobol-mode-abbrev-table ";ext"  "EXTEND" nil)
    (define-abbrev cobol-mode-abbrev-table ";f"    "FALSE" nil)
    (define-abbrev cobol-mode-abbrev-table ";fc"   "FILE-CONTROL" nil)
    (define-abbrev cobol-mode-abbrev-table ";fi"   "FILLER" nil)
    (define-abbrev cobol-mode-abbrev-table ";fo"   "FOOTING" nil)
    (define-abbrev cobol-mode-abbrev-table ";g"    "GENERATE" nil)
    (define-abbrev cobol-mode-abbrev-table ";gi"   "GIVING" nil)
    (define-abbrev cobol-mode-abbrev-table ";gl"   "GLOBAL" nil)
    (define-abbrev cobol-mode-abbrev-table ";gr"   "GREATER" nil)
    (define-abbrev cobol-mode-abbrev-table ";gro"  "GROUP" nil)
    (define-abbrev cobol-mode-abbrev-table ";h"    "HEADING" nil)
    (define-abbrev cobol-mode-abbrev-table ";hv"   "HIGH-VALUE" nil)
    (define-abbrev cobol-mode-abbrev-table ";io"   "I-O-CONTROL" nil)
    (define-abbrev cobol-mode-abbrev-table ";id"   "IDENTIFICATION" nil)
    (define-abbrev cobol-mode-abbrev-table ";in"   "INDEXED" nil)
    (define-abbrev cobol-mode-abbrev-table ";ind"  "INDICATE"  nil)
    (define-abbrev cobol-mode-abbrev-table ";ini"  "INITIATE" nil)
    (define-abbrev cobol-mode-abbrev-table ";inp"  "INPUT" nil)
    (define-abbrev cobol-mode-abbrev-table ";ino"  "INPUT-OUTPUT" nil)
    (define-abbrev cobol-mode-abbrev-table ";ins"  "INSPECT" nil)
    (define-abbrev cobol-mode-abbrev-table ";i"    "INVALID" nil)
    (define-abbrev cobol-mode-abbrev-table ";j"    "JUST" nil)
    (define-abbrev cobol-mode-abbrev-table ";ju"   "JUSTIVIED" nil)
    (define-abbrev cobol-mode-abbrev-table ";k"    "KEY" nil)
    (define-abbrev cobol-mode-abbrev-table ";lab"  "LABEL" nil)
    (define-abbrev cobol-mode-abbrev-table ";la"   "LAST" nil)
    (define-abbrev cobol-mode-abbrev-table ";le"   "LEADING" nil)
    (define-abbrev cobol-mode-abbrev-table ";li"   "LIMIT" nil)
    (define-abbrev cobol-mode-abbrev-table ";len"  "LENGTH" nil)
    (define-abbrev cobol-mode-abbrev-table ";lc"   "LINE-COUNTER" nil)
    (define-abbrev cobol-mode-abbrev-table ";lin"  "LINKAGE" nil)
    (define-abbrev cobol-mode-abbrev-table ";lv"   "LOW-VALUE" nil)
    (define-abbrev cobol-mode-abbrev-table ";mem"  "MEMORY" nil)
    (define-abbrev cobol-mode-abbrev-table ";mer"  "MERGE" nil)
    (define-abbrev cobol-mode-abbrev-table ";mes"  "MESSAGE" nil)
    (define-abbrev cobol-mode-abbrev-table ";mo"   "MODE" nil)
    (define-abbrev cobol-mode-abbrev-table ";mod"  "MODULES" nil)
    (define-abbrev cobol-mode-abbrev-table ";m"    "MOVE" nil)
    (define-abbrev cobol-mode-abbrev-table ";mu"   "MULTIPLY" nil)
    (define-abbrev cobol-mode-abbrev-table ";mul"  "MULTIPLE" nil)
    (define-abbrev cobol-mode-abbrev-table ";na"   "NATIVE" nil)
    (define-abbrev cobol-mode-abbrev-table ";neg"  "NEGATIVE" nil)
    (define-abbrev cobol-mode-abbrev-table ";ne"   "NEXT" nil)
    (define-abbrev cobol-mode-abbrev-table ";nu"   "NUMBER" nil)
    (define-abbrev cobol-mode-abbrev-table ";n"    "NUMERIC" nil)
    (define-abbrev cobol-mode-abbrev-table ";oc"   "OBJECT-COMPUTER" nil)
    (define-abbrev cobol-mode-abbrev-table ";o"    "OCCURS" nil)
    (define-abbrev cobol-mode-abbrev-table ";om"   "OMITTED" nil)
    (define-abbrev cobol-mode-abbrev-table ";op"   "OPEN" nil)
    (define-abbrev cobol-mode-abbrev-table ";opt"  "OPTIONAL" nil)
    (define-abbrev cobol-mode-abbrev-table ";ose"  "ON SIZE ERROR" nil)
    (define-abbrev cobol-mode-abbrev-table ";or"   "ORGANIZATION" nil)
    (define-abbrev cobol-mode-abbrev-table ";ou"   "OUTPUT" nil)
    (define-abbrev cobol-mode-abbrev-table ";ov"   "OVERFLOW" nil)
    (define-abbrev cobol-mode-abbrev-table ";pc"   "PAGE-COUNTER" nil)
    (define-abbrev cobol-mode-abbrev-table ";p"    "PERFORM" nil)
    (define-abbrev cobol-mode-abbrev-table ";pi"   "PICTURE"  nil)
    (define-abbrev cobol-mode-abbrev-table ";poi"  "POINTER" nil)
    (define-abbrev cobol-mode-abbrev-table ";pos"  "POSITION" nil)
    (define-abbrev cobol-mode-abbrev-table ";pv"   "POSITIVE" nil)
    (define-abbrev cobol-mode-abbrev-table ";pri"  "PRINTING" nil)
    (define-abbrev cobol-mode-abbrev-table ";pr"   "PROCEDURE" nil)
    (define-abbrev cobol-mode-abbrev-table ";pro"  "PROCEED" nil)
    (define-abbrev cobol-mode-abbrev-table ";prg"  "PROGRAM" nil)
    (define-abbrev cobol-mode-abbrev-table ";pid"  "PROGRAM-ID" nil)
    (define-abbrev cobol-mode-abbrev-table ";ra"   "RANDOM" nil)
    (define-abbrev cobol-mode-abbrev-table ";r"    "READ" nil)
    (define-abbrev cobol-mode-abbrev-table ";rec"  "RECEIVE" nil)
    (define-abbrev cobol-mode-abbrev-table ";re"   "RECORD" nil)
    (define-abbrev cobol-mode-abbrev-table ";red"  "REDEFINES" nil)
    (define-abbrev cobol-mode-abbrev-table ";ref"  "REFERENCES" nil)
    (define-abbrev cobol-mode-abbrev-table ";ret"  "RELATIVE" nil)
    (define-abbrev cobol-mode-abbrev-table ";rel"  "RELEASE" nil)
    (define-abbrev cobol-mode-abbrev-table ";rem"  "REMAINDER" nil)
    (define-abbrev cobol-mode-abbrev-table ";ren"  "RENAMES" nil)
    (define-abbrev cobol-mode-abbrev-table ";rep"  "REPLACING" nil)
    (define-abbrev cobol-mode-abbrev-table ";res"  "RESERVE" nil)
    (define-abbrev cobol-mode-abbrev-table ";ret"  "RETURN" nil)
    (define-abbrev cobol-mode-abbrev-table ";rev"  "REVERSED" nil)
    (define-abbrev cobol-mode-abbrev-table ";rew"  "REWRITE" nil)
    (define-abbrev cobol-mode-abbrev-table ";ro"   "ROUNDED" nil)
    (define-abbrev cobol-mode-abbrev-table ";s"    "SEARCH" nil)
    (define-abbrev cobol-mode-abbrev-table ";se"   "SECTION" nil)
    (define-abbrev cobol-mode-abbrev-table ";sec"  "SECURITY" nil)
    (define-abbrev cobol-mode-abbrev-table ";seg"  "SEGMENT" nil)
    (define-abbrev cobol-mode-abbrev-table ";sl"   "SELECT" nil)
    (define-abbrev cobol-mode-abbrev-table ";sen"  "SENTENCE" nil)
    (define-abbrev cobol-mode-abbrev-table ";seq"  "SEQUENTIAL" nil)
    (define-abbrev cobol-mode-abbrev-table ";sc"   "SOURCE-COMPUTER" nil)
    (define-abbrev cobol-mode-abbrev-table ";sp"   "SPACES" nil)
    (define-abbrev cobol-mode-abbrev-table ";spn"  "SPECIAL-NAMES" nil)
    (define-abbrev cobol-mode-abbrev-table ";sta"  "STANDARD" nil)
    (define-abbrev cobol-mode-abbrev-table ";st"   "START" nil)
    (define-abbrev cobol-mode-abbrev-table ";stt"  "STATUS" nil)
    (define-abbrev cobol-mode-abbrev-table ";str"  "STRING" nil)
    (define-abbrev cobol-mode-abbrev-table ";su"   "SUBTRACT" nil)
    (define-abbrev cobol-mode-abbrev-table ";sy"   "SYMBOLIC" nil)
    (define-abbrev cobol-mode-abbrev-table ";syn"  "SYNCHRONIZED" nil)
    (define-abbrev cobol-mode-abbrev-table ";ta"   "TABLE" nil)
    (define-abbrev cobol-mode-abbrev-table ";te"   "TERMINAL" nil)
    (define-abbrev cobol-mode-abbrev-table ";ter"  "TERMINATE" nil)
    (define-abbrev cobol-mode-abbrev-table ";pid"  "PROGRAM-ID" nil)
    (define-abbrev cobol-mode-abbrev-table ";t"    "TEST" nil)
    (define-abbrev cobol-mode-abbrev-table ";th"   "THROUGH" nil)
    (define-abbrev cobol-mode-abbrev-table ";ti"   "TIMES" nil)
    (define-abbrev cobol-mode-abbrev-table ";u"    "UNTIL" nil)
    (define-abbrev cobol-mode-abbrev-table ";us"   "USAGE" nil)
    (define-abbrev cobol-mode-abbrev-table ";usi"  "USING" nil)
    (define-abbrev cobol-mode-abbrev-table ";v"    "VALUE" nil)
    (define-abbrev cobol-mode-abbrev-table ";va"   "VARYING" nil)
    (define-abbrev cobol-mode-abbrev-table ";wst"  "WORKING-STORAGE" nil)
    (define-abbrev cobol-mode-abbrev-table ";w"    "WRITE" nil)
    (define-abbrev cobol-mode-abbrev-table ";z"    "ZERO" nil)))


					; RF02, RB02
					; 1.1 cobol-mode
(defun cobol-mode ()
  "Major mode for editing COBOL '74 and COBOL '85 code."

  (interactive)
  (kill-all-local-variables)
  (display-time)
  (message "ClOMO (cobol-mode) v1.0 by peters & weiss Lbg '94, 4 xemacs by Azou")
					; RF02.02, RB02.02
					; 1.3 abbrev-mode
  (if (string= "windows-nt" system-type)
      (setq cobol-mode-system-type "WIN32")
    ;;    (setq cobol-mode-system-type (symbol-name system-type))
    ;;else
    (if (string-match "XEmacs\\|Lucid" emacs-version)
	(progn
	  (shell-command "uname -s" "system-type")
	  (setq cobol-mode-system-type (buffer-substring (point-min "system-type") (- (point-max "system-type") 1) "system-type"))
	  (kill-buffer "system-type"))
      ;;else
      (setq cobol-mode-system-type (symbol-name system-type))))


  (setq local-abbrev-table cobol-mode-abbrev-table)
  (make-local-variable 'abbrev-all-caps)
  (setq abbrev-all-caps t)
  (abbrev-mode t)
  (make-local-variable 'indent-tabs-mode)
  (setq indent-tabs-mode nil)
  (make-local-variable 'cobol-buffer-limit)
  (setq cobol-buffer-limit (point-min))
  (make-local-variable 'cobol-column)
  (setq cobol-column 10)
  (make-local-variable 'cobol-list-lst)
  (setq cobol-list-lst (cons 0'()))
  (make-local-variable 'cobol-list-cbl)
  (setq cobol-list-cbl (cons 0'()))
  (make-local-variable 'cobol-max-list)
  (setq cobol-max-list (list 0))
  (make-local-variable 'cobol-construct-list)
  (setq cobol-construct-list
	(list cobol-end
	      cobol-perform-until cobol-if
	      cobol-else cobol-then cobol-when
	      cobol-evaluate
	      cobol-on-size-error
	      cobol-invalid cobol-at-end
	      cobol-not-at-end cobol-not-invalid
	      cobol-not-on-size-error
	      cobol-arrowl cobol-arrowr))
  (make-local-variable 'cobol-position-list)
  (setq cobol-position-list
	(list 0 0 3 3 3 3 3 3 4 4 4 3 3 3 4 99))
  (make-local-variable 'cobol-pointer)
  (setq cobol-pointer 0)
  (make-local-variable 'cobol-condition)
  (setq cobol-condition " ")
  (make-local-variable 'cobol-author)
  (setq cobol-author (user-login-name))
  (make-local-variable 'cobol-date-written)
  (setq cobol-date-written (current-time-string))
  (make-local-variable 'declare)
  (setq declare " ")
  (use-local-map cobol-mode-map)
  (setq major-mode 'cobol-mode)
  (setq buffer-read-only nil)
  (setq mode-name "(clobol-mode)")
  (goto-char 1)
					; RF13, RB13
  (line-number-mode 1)
  (cobol-suspend-parameter)
					; RF13, RB13
;;  (set-screen-width 73)
  (set-syntax-table cobol-mode-syntax-table)
  (setq truncate-lines t)
					; RF02.01, RB02.01
  ;; config font-lock mode   --azou 4/96
(if (string-match "XEmacs" emacs-version)
    ()
  ;;;else
  (defvar font-lock-preprocessor-face 'font-lock-preprocessor-face)
  (defface font-lock-preprocessor-face
    '((((class grayscale) (background light)) (:foreground "DimGray" :italic t))
      (((class grayscale) (background dark)) (:foreground "LightGray" :italic t))
      (((class color) (background light)) (:foreground "Yellow"))
      (((class color) (background dark)) (:foreground "Khaki"))
      (t (:italic t)))
    "defined in cobol.el" 
    :group 'font-lock-highlighting-faces)
)
  (setq cobol-hilite-lowercase (- 1 cobol-hilite-lowercase))
  (cobol-hilite-toggle)


  ;; add own write-hook  --azou 4/96
;  (add-hook 'cobol-mode-hook
;	    (function
;	     (lambda ()
;	       (make-variable-buffer-local 'write-file-hooks)
;	       (add-hook 'write-file-hooks
;			 'cobol-mode-save-boni))))

  ;; Let the user customize
  (run-hooks 'cobol-mode-hook)

  (cobol-insert-frame)

  ;; activate menu-bar
  (if (string-match "XEmacs\\|Lucid" emacs-version)
      (progn
	(set-buffer-menubar clomo-menubar)
	(add-menu-button '("Help") ["About ClOMO..." cobol-show-gorgeous t] "About XEmacs...")
	(set-menubar-dirty-flag)

	;; Let Azundris azundrize
	(if (= cobol-azou-flag 0)
	    (cobol-show-gorgeous 3))))

  ;; Switch outlining on by default
  (outline-minor-mode t)

  ;; oh, and do add that fancy column display
  (setq modeline-format
	(list (purecopy "")
	      'modeline-modified
	      'modeline-buffer-identification
	      (purecopy "   ")
	      'global-mode-string
	      (purecopy "   %[(")
	      'mode-name 'minor-mode-alist "%n" 'modeline-process
	      (purecopy ")%]----")
	      (purecopy '(line-number-mode "%l/"))
	      (purecopy "%c--")
	      (purecopy '(-3 . "%p"))
	      (purecopy "-%-")))

)



(defun clomo ()
  "Shortcut for activating the COBOL major mode."

  (interactive)
  (cobol-mode))

(defun clobol-mode ()
  "Shortcut for activating the COBOL major mode."

  (interactive)
  (cobol-mode))



(defun cobol-hilite-toggle ()
  "hilight uppercase (COBOL 74) or lowercase (COBOL 85) keywords."

  (interactive)
  (setq cobol-hilite-lowercase (- 1 cobol-hilite-lowercase))
  (if (= cobol-hilite-lowercase 1)
      (setq cobol-mode-font-lock-keywords
	    (list
	     (cons
	      (concat "\\( " (mapconcat 'downcase cobol-multi-keywords "\\|") "\\)") 1)
	     (cons (concat
		    "\\(\\<" (mapconcat 'downcase cobol-keywords "\\>\\|\\<") "\\>\\)") 1)
	     ;; Fontify function names
	     '("\\(^[1 ][1 ][1 ][1 ]   [-A-Za-z_0-9]+\\( section\\)?\\.\\)" 1 font-lock-function-name-face)
	     ;; Fontify reserved levels (01, 77 and 88). Second line: indent for FD
	     '("\\(^[1 ][1 ][1 ][1 ]   \\(fd\\|sd\\|01\\|77\\|88\\)[ \t\.]\\)" 1 font-lock-type-face)
	     '("\\(^[1 ][1 ][1 ][1 ]       01\\)" 1 font-lock-type-face)
	     ;; Fontify comments
	     '("\\(^      [*/].*\\)" 1 font-lock-comment-face t)
;;	     '("\\(^......[*/].*\\)" 1 font-lock-comment-face t)
	     ;; Fontify $-switches for our compiler
	     '("\\(^      \\$.*\\)" 1 font-lock-string-face t)
	     ;; fontify HTML
	     '("\\(</?[A-Za-z]+[1-6]?\\([\t ]+\\([^\t> ]\\)*\\)*>\\)" 1 font-lock-preprocessor-face t)
	     '("\\([0-9 ][0-9][0-9][0-9][0-9][0-9]\\*\\)" 1 font-lock-preprocessor-face t)
	     ;; Toys
	     '("\\([Aa]zundris\\)" 1 font-lock-string-face t)
	     '("\\([Aa]zou\\)" 1 font-lock-string-face t)))
    (setq cobol-mode-font-lock-keywords
	  (list
	   (cons
	    (concat "\\( " (mapconcat 'upcase cobol-multi-keywords "\\|") "\\)") 1)
	   (cons (concat
		  "\\(\\<" (mapconcat 'upcase cobol-keywords "\\>\\|\\<") "\\>\\)") 1)
	   ;; Fontify function names
	   '("\\(^[1 ][1 ][1 ][1 ]   [-A-Z_0-9]+\\( SECTION\\)?\\.\\)" 1 font-lock-function-name-face)
	   ;; Fontify reserved levels (01, 77 and 88). Second line: indent for FD
	   '("\\(^[1 ][1 ][1 ][1 ]   \\(FD\\|SD\\|01\\|77\\|88\\)[ \t\.]\\)" 1 font-lock-type-face)
	   '("\\(^[1 ][1 ][1 ][1 ]       01\\)" 1 font-lock-type-face)
	   ;; Fontify comments
	   '("\\(^      [*/].*\\)" 1 font-lock-comment-face t)
;;         '("\\(^......[*/].*\\)" 1 font-lock-comment-face t)
	   ;; Fontify $-switches for our compiler
	   '("\\(^      \\$.*\\)" 1 font-lock-string-face t)
	   ;; fontify HTML
	   '("\\(</?[A-Za-z]+[1-6]?\\([\t ]+\\([^\t> ]\\)*\\)*>\\)" 1 font-lock-preprocessor-face t)
	   '("\\([0-9 ][0-9][0-9][0-9][0-9][0-9]\\*\\)" 1 font-lock-preprocessor-face t))))

  (if (string-match "XEmacs" emacs-version)
      (progn
	(remprop 'cobol-mode	'font-lock-keywords)
	(put 'cobol-mode	'font-lock-keywords 'cobol-mode-font-lock-keywords)
	(make-local-variable  'font-lock-keywords)
	(setq font-lock-keywords cobol-mode-font-lock-keywords))
    ;;else
    ;; (font-lock-unset-defaults)
    (put 'cobol-mode	'font-lock-keywords 'cobol-mode-font-lock-keywords)
    (make-local-variable 'font-lock-defaults)
    (setq font-lock-defaults '(cobol-mode-font-lock-keywords t))
    (font-lock-set-defaults))
  (font-lock-fontify-buffer))


					;help-function to display messages
					;in minibuffer
(defun cobol-message (message-title variable)
  (save-excursion
    (message message-title variable)
    (beep)
    (sit-for 5)
    (message nil)))

					; RF01, RF01.01, RB01
					; 1.2 insert-frame


(defun cobol-insert-frame ()
  (if (= (point-min) (point-max))
      (progn
	(goto-char 1)
	(insert cobol-PrgFrame)
	(goto-char 1)

	                                ; --azou 4/96
	;; the following four lines are only needed with the HTML header that I removed. theBlackDragon, 23/07/2005
	;;(search-forward cobol-string-title)
	;;(insert (buffer-name))
	;;(search-forward cobol-string-title)
	;;(insert (buffer-name))
	(goto-char 1)

					; RF01.01.01, RB01
	(search-forward cobol-program-id)
	(insert (concat "\n           " (buffer-name)))
	(let
	    ((erg (search-backward "c")))
	  (setq start (point))
	  (forward-sexp 1)
	  (delete-region start (point)))
					; RF01.01.03, RB01
	(search-forward cobol-string-author)
	(insert (concat "\n           " cobol-author "."))
					; RF01.01.02, RB01
	(search-forward cobol-string-date-written)
	(insert (concat "\n           " cobol-date-written "."))

	(search-forward "~")            ; --azou 3/99  (machine)
	(delete-char -1)
	(insert cobol-mode-system-type)
	(search-forward "~")
	(delete-char -1)
	(insert cobol-mode-system-type)

	(search-forward cobol-k-programid)
	(if (search-forward "PIC X(" nil t)
	    (insert
	     (int-to-string
	      (- (length (buffer-name)) 4))))
	(search-forward cobol-value)
	(forward-char 2)
	(insert (buffer-name))
	(let
	    ((erg (search-backward ".")))
	  (setq start (point))
	  (forward-sexp 1)
	  (delete-region start (point)))
	(search-forward cobol-k-autorid)
	(if (search-forward "PIC X(" nil t)
	    (insert
	     (int-to-string
	      (length cobol-author))))
	(search-forward cobol-value)
	(forward-char 2)
	(insert cobol-author)
	(if (search-forward cobol-procedure-division nil t)
	    (progn
	      (end-of-line)
	      (newline 2)
					; RF01.01.04, RB01
;; buffer-name set to upcase --azou 4/96
	      (insert (concat "       S1-"(upcase(buffer-name))) " SECTION.")
	      (let
		  ((erg (search-backward ".cbl")))
		(setq start (point))
		 (forward-sexp 1)
		 (delete-region start (point)))
	      (end-of-line)
	      (newline)
	      (insert "       ANFANG-S1.\n           \n")
	      (insert "       ENDE-S1. \n")
	      (insert "           STOP RUN.\n\n      *\n")
	      (insert cobol-html-foot)
              (cobol-hide-html)                     ;; ""
	      (next-line -3)
	      (move-to-column 11 t)
	      )))))

(defun cobol-add-paragraph ()
  "Insert a paragraph or section at current line by
 \\[cobol-add-paragraph]."

  (interactive)
  (let (end-line search-limit
	paragraph-name cobol-string
	(cursor (point)))
    (cobol-search-procedure)
    (if (not (= cobol-buffer-limit 0))
	 (if (re-search-backward "S1-[0-9a-z -]*SECTION" nil t)
	     (progn
	       (setq search-limit (point))
	       (goto-char cursor)
	       (end-of-line)
	       (setq end-line (point))
	       (beginning-of-line)
	       (if (re-search-forward "[^ \\|\n]" end-line t)
		   (cobol-message "I miss an empty line to insert the paragraph!" nil)
		 (progn
		   (cobol-minibuffer-input
		    "Name of PARAGRAPH:" "PARAGRAPH")
		   (setq paragraph-name cobol-string)
		   (if (not (search-backward
			     (concat paragraph-name ".") search-limit t))
		       (progn
			 (move-to-column 7 t)
			 (insert (concat paragraph-name "."))
			 (newline 1)
			 (move-to-column 6 t)
			 (insert "*\n")
			 (move-to-column 7 t)
			 (insert "ANFANG.\n")
			 (newline 1)
			 (move-to-column 11 t)
			 (insert ".\n")
			 (next-line -2)
			 (move-to-column 11 t))
		     (progn
		       (cobol-message "PARAGRAPH %s allready exists!"
				      paragraph-name)
		       (goto-char cursor))))))
	   (cobol-message "I miss S1-... SECTION." nil)))))

					; RF03.07, RB03.07
					; 2.5.2 file-control

(defun cobol-file-control ()
  "Insert FILE-CONTROL entries by naming a file and specifying other
   file-related information (sequential files, relative files, indexed
   files) by user. It inserts the specified file name in the FD and
   generates DECLARATIVES."

  (interactive)
  (let
      (organization cobol-string
       (access-mode cobol-upper-sequential)
       record-key select-name
       (cursor (point))
       relative-key end-line
       assign-name (read t))
    (save-excursion
      (delete-other-windows)
      (split-window-vertically)
      (recenter)
      (other-window 1)
      (goto-char 1)
      (if (not (re-search-forward "       FILE-CONTROL." nil t))
	  (progn
	    (cobol-message "I can't find a correct 'FILE-CONTROL'" nil)
	    (other-window 1)
	    (delete-other-windows))
	(progn
	  (if (not (search-forward "       DATA DIVISION" nil t))
	      (progn
		(cobol-message "I can't find correct \"DATA DIVISION\"" nil)
		(other-window 1)
		(delete-other-windows))
	    (progn
	      (next-line -2)
	      (end-of-line)
	      (setq end-line (point))
	      (beginning-of-line)
	      (setq cursor (point))
	      (if (re-search-forward "[^ \\|\n]" end-line t)
		  (progn
		    (cobol-message "I miss an empty line in the end of FILE-CONTROL!" nil)
		    (other-window 1)
		    (delete-other-windows))
		(progn
		  (cobol-minibuffer-input
		   "Name of 'SELECT' FILE-NAME :" "FILE-NAME")
		  (setq select-name cobol-string)
		  (if (re-search-backward
		       (concat "SELECT[^a-z]*" select-name) nil t)
		      (progn
			(cobol-message "SELECT-name %s already exists!"
				       select-name)
			(other-window 1)
			(delete-other-windows))
		    (progn
		      (cobol-get-file-control)
		      (cobol-insert-file-control)
		      (cond
		       ((or (string-equal
			     cobol-indexed organization)
			    (string-equal
			     cobol-upper-indexed organization))
			(if (search-backward
			     cobol-working-storage-section nil t)
			    (cobol-message "Declare RECORD KEY!" nil)))
		       ((or (string-equal
			     cobol-relative organization)
			    (string-equal
			     cobol-upper-relative organization))
			(if (or (string-equal
				 cobol-random access-mode)
				(string-equal
				 cobol-upper-random access-mode)
				(string-equal
				 cobol-dynamic access-mode)
				(string-equal
				 cobol-upper-dynamic access-mode))
			    (if (search-backward
				 cobol-working-storage-section nil t)
				(cobol-message "Declare RELATIVE KEY!"
					       nil))))
		       (t (if (search-backward
			       cobol-working-storage-section nil t)
			 (cobol-message "File declarations added!" nil))))
		      (other-window 1)
		      (recenter))))))))))))

					; RF03.07, RB03.07
					; 2.5.3 get-file-control
(defun cobol-get-file-control ()
  (let
      ((file-status-pruef t))
    (cobol-minibuffer-input
     "Name of 'ASSIGN' FILE-NAME:" "FILE-NAME")
    (setq assign-name cobol-string)
    (cobol-minibuffer-input
     "ORGANIZATION:" "ORGANIZATION")
    (setq organization cobol-string)
    (while (string-equal "t" read)
      (if (not (or (string-equal
		    cobol-upper-sequential organization)
		   (string-equal
		    cobol-sequential organization)
		   (string-equal
		    cobol-indexed organization)
		   (string-equal
		    cobol-upper-indexed organization)
		   (string-equal
		    cobol-relative organization)
		   (string-equal
		    cobol-upper-relative organization)))
	  (progn
	    (cobol-message "Unknown organization!" nil)
	    (cobol-minibuffer-input
	     "ORGANIZATION:" "ORGANIZATION")
	    (setq organization cobol-string))
	(setq read "nil")))
    (if (not (or (string-equal cobol-upper-sequential organization)
		 (string-equal cobol-sequential organization)))
	(progn
	  (cobol-minibuffer-input
	   "ACCESS MODE:" "ACCESS MODE")
	  (setq access-mode cobol-string)))
    (setq read "t")
    (while (string-equal "t" read)
      (if (not (or (string-equal
		    cobol-upper-sequential access-mode)
		   (string-equal
		    cobol-sequential access-mode)
		   (string-equal
		    cobol-upper-random access-mode)
		   (string-equal
		    cobol-random access-mode)
		   (string-equal
		    cobol-dynamic access-mode)
		   (string-equal
		    cobol-upper-dynamic access-mode)))
	  (progn
	    (cobol-message "Unknown access-mode, 'sequential' 'random' 'dynamic' required!" nil)
	    (cobol-minibuffer-input
	     "ACCESS MODE:" "ACCESS MODE")
	    (setq access-mode cobol-string))
	(setq read "nil")))
    (if (or (string-equal
	     cobol-upper-relative organization)
	    (string-equal
	     cobol-relative organization))
	(if (or (string-equal
		 cobol-random access-mode)
		(string-equal
		 cobol-upper-random access-mode)
		(string-equal
		 cobol-dynamic access-mode)
		(string-equal
		 cobol-upper-dynamic access-mode))
	    (progn
	      (cobol-minibuffer-input
	       "RELATIVE KEY:" "RELATIVE KEY")
	      (setq relative-key cobol-string))))
    (if (or (string-equal cobol-indexed organization)
	    (string-equal cobol-upper-indexed organization))
	(progn
	  (cobol-minibuffer-input
	   "RECORD KEY:" "RECORD KEY")
	      (setq record-key cobol-string)))
    (while (string-equal "t" file-status-pruef)
      (cobol-minibuffer-input
       "FILE STATUS:" "FILE STATUS")
      (setq file-status cobol-string)
      (if (re-search-forward
	   (concat "\\([^*][77][77][^a-z]+" file-status "\\)") nil t)
	  (cobol-message "FILE STATUS %s already exists!" file-status)
	(setq file-status-pruef "nil")))))

					; RF03.07.01, RF03.07.02
					; RB03.07.01, RB03.07.02
					; 2.5.4 insert-file-control
(defun cobol-insert-file-control ()
  (goto-char cursor)
  (move-to-column 11 t)
  (insert
   (concat "SELECT " select-name " ASSIGN TO "
	   "\""assign-name"\"" "\n           ORGANIZATION IS "
	   organization "\n           ACCESS MODE IS " access-mode))
  (cond
   ((or (string-equal
	 cobol-indexed organization)
	(string-equal
	 cobol-upper-indexed organization))
    (insert "\n           RECORD KEY IS " record-key))
   ((or (string-equal
	 cobol-relative organization)
	(string-equal
	 cobol-upper-relative organization))
    (if (or (string-equal
	     cobol-random access-mode)
	    (string-equal
	     cobol-upper-random access-mode)
	    (string-equal
	     cobol-dynamic access-mode)
	    (string-equal
	     cobol-upper-dynamic acces-mode))
	(insert "\n           RELATIVE KEY IS " relative-key))))
  (insert "\n           FILE STATUS IS " file-status ".\n\n")
  (if (search-forward cobol-working-storage-section nil t)
      (progn
	(next-line -2)
	(end-of-line)
	(setq end-line (point))
	(beginning-of-line)
	(if (re-search-forward "[^ \\|\n]" end-line t)
	    (progn
	      (end-of-line)
	      (newline)))
 	(move-to-column 7 t)
	(insert
	 (concat "FD  " select-name ".\n")))
    (progn
      (cobol-message "I miss WORKING-STORAGE SECTION , Can't insert FD %s!"
		     select-name)))
   (if (search-forward cobol-working-storage-section nil t)
       (progn
	 (forward-char 1)
	 (newline)
	 (move-to-column 7 t)
	 (insert
	  (concat"77  " file-status "     PIC XX.")))
     (progn
       (cobol-message "I miss W-S SECTION, Can't insert declaration of FILE-STATUS!"
		      select-name)))
   (if (not (re-search-forward "S1-[0-9a-z -]*SECTION" nil t))
       (cobol-message "I miss S1-??? SECTION, Can't insert DECLARATIVES" nil)
     (if (search-backward "       END DECLARATIVES" nil t)
	 (progn
	   (next-line -1)
	   (end-of-line)
	   (newline)
	   (move-to-column 7 t)
;	   (insert "FEHLER SECTION.\n")
	   (insert "ERROR-HANDLER SECTION.\n")
	   (move-to-column 11 t)
	   (insert (concat "USE AFTER ERROR PROCEDURE ON "
			   select-name ".\n"))
	    (move-to-column 7 t)
	   (insert "ANFANG.\n")
	   (move-to-column 11 t)
	   (insert
;	    (concat "DISPLAY \"FEHLER BEI ZUGRIFF AUF "
	    (concat "DISPLAY \"Error accessing "
		    select-name " \" AT 1001\n"))
	   (move-to-column 11 t)
	   (insert
;	    (concat "DISPLAY \"FEHLERCODE: \"  AT 1101 "
;		    file-status " AT 1113.\n"))
	    (concat "DISPLAY \"Error #\"  AT 1101 "
		    file-status " AT 1108.\n"))
	   (move-to-column 7 t)
	   (insert "ENDE.\n"))
       (progn
	 (next-line -1)
	 (newline)
	 (move-to-column 7 t)
	 (insert "DECLARATIVES.\n")
	 (move-to-column 7 t)
;	 (insert "FEHLER SECTION.\n")
	 (insert "ERROR-HANDLER SECTION.\n")
	 (move-to-column 11 t)
	 (insert (concat "USE AFTER ERROR PROCEDURE ON "
			 select-name ".\n"))
	 (move-to-column 7 t)
	 (insert "ANFANG.\n")
	 (move-to-column 11 t)
	 (insert
;	  (concat "DISPLAY \"FEHLER BEI ZUGRIFF AUF "
	  (concat "DISPLAY \"Error accessing "
		  select-name " \" AT 1001\n"))
	 (move-to-column 11 t)
	 (insert
;	  (concat "DISPLAY \"FEHLERCODE: \"  AT 1101 "
;	  file-status " AT 1113.\n"))
	    (concat "DISPLAY \"Error #\"  AT 1101 "
		    file-status " AT 1108.\n"))
	 (move-to-column 7 t)
	 (insert "ENDE.\n")
	 (move-to-column 7 t)
	 (insert "END DECLARATIVES.\n")))))

					; RF03.04, RB03.04
					; 2.5.5 insert-construct
(defun cobol-insert-if ()
"Insert the construct IF
                     THEN
                     ELSE
                     END-IF
at current line and ask for condition by  \\[cobol-insert-if]."
  (interactive)
  (let
      (end-line condition cobol-string
       (position (point))
       (length 10))
    (cobol-search-procedure)
    (if (= cobol-buffer-limit 0)
	(goto-char position)
      (progn
	(end-of-line)
	(setq end-line (point))
	(beginning-of-line)
	(if (re-search-forward "[^ \\|\n]" end-line t)
	    (cobol-message "Insert construct in empty lines only!" nil)
	  (progn
	    (cobol-indent length position)
	    (cobol-minibuffer-input
	     "Condition:" "Condition")
	    (setq condition cobol-string)
	    (move-to-column cobol-column t)
	    (insert " IF ")
	    (move-to-column (+ cobol-column 4)t)
	    (insert (concat condition "\n"))
	    (move-to-column cobol-column t)
	    (insert " THEN \n ")
	    (move-to-column (+ cobol-column 4)t)
	    (setq cursor (point))
	    (insert "\n")
	    (move-to-column cobol-column t)
	    (insert " ELSE \n")
	    (setq cobol-column (+ cobol-column 3))
	    (move-to-column cobol-column t)
	    (insert " CONTINUE \n")
	    (setq cobol-column (- cobol-column 3))
	    (move-to-column cobol-column t)
	    (insert " END-IF")
	    (goto-char cursor)))))))

					; RF03.04, RB03.04
					; 2.5.5 insert-construct
(defun cobol-insert-perform-test-after ()
"Insert the construct PERFORM WITH TEST AFTER UNTIL
                     END-PERFORM
at current line and ask for condition by \\[cobol-insert-perform-test-after]."
  (interactive)
  (let
      (end-line condition cobol-string
		(position (point))(length 27))

    (cobol-search-procedure)
    (if (= cobol-buffer-limit 0)
	(goto-char position)
      (progn
	(end-of-line)
	(setq end-line (point))
	(beginning-of-line)
	(if (re-search-forward "[^ \\|\n]" end-line t)
	    (cobol-message "Insert construct in empty lines only!" nil)
	  (progn
	    (cobol-indent length position)
	    (cobol-minibuffer-input
	     "Condition:" "Condition")
	    (setq condition cobol-string)
	    (move-to-column cobol-column t)
	    (insert " PERFORM TEST AFTER UNTIL ")
	    (move-to-column (+ cobol-column 26) t)
	    (insert (concat condition "\n"))
	    (move-to-column (+ cobol-column 4) t)
	    (setq cursor (point))
	    (insert "\n")
	    (move-to-column cobol-column t)
	    (insert " END-PERFORM")
	    (goto-char cursor)))))))

					; RF03.04, RB03.04
					; 2.5.5 insert-construct
(defun cobol-insert-perform-until ()
"Insert the construct PERFORM UNTIL
                     END-PERFORM
at current line and ask for condition by \\[cobol-insert-perform-until]."
  (interactive)
  (let
      (end-line condition cobol-string
		(position (point))(length 15))
    (cobol-search-procedure)
    (if (= cobol-buffer-limit 0)
	(goto-char position)
      (progn
	(end-of-line)
	(setq end-line (point))
	(beginning-of-line)
	(if (re-search-forward "[^ \\|\n]" end-line t)
	    (cobol-message "Insert construct in empty lines only!" nil)
	  (progn
	    (cobol-indent length position)
	    (cobol-minibuffer-input
	     "Condition:" "Condition")
	    (setq condition cobol-string)
	    (move-to-column cobol-column t)
	    (insert " PERFORM UNTIL ")
	    (move-to-column (+ cobol-column 15) t)
	    (insert (concat condition "\n"))
	    (move-to-column (+ cobol-column 4) t)
	    (setq cursor (point))
	    (insert "\n")
	    (move-to-column cobol-column t)
	    (insert " END-PERFORM")
	    (goto-char cursor)))))))

					; RF03.04, RB03.04
					;2.5.5 insert-construct
(defun cobol-insert-evaluate ()
"Insert the construct EVALUATE TRUE
                     WHEN
                     WHEN
                     WHEN OTHER
                     END-EVALUATE
at current line by \\[cobol-insert-evaluate]."
  (interactive)
  (let
      (end-line (position (point))(length 15))
    (cobol-search-procedure)
    (if (= cobol-buffer-limit 0)
	(goto-char position)
      (progn
	(end-of-line)
	(setq end-line (point))
	(beginning-of-line)
	(if (re-search-forward "[^ \\|\n]" end-line t)
	    (cobol-message "Insert construct in empty lines only!" nil)
	  (progn
	    (cobol-indent length position)
	    (move-to-column cobol-column t)
	    (insert " EVALUATE TRUE \n")
	    (move-to-column cobol-column t)
	    (insert " WHEN  ")
	    (setq cursor (point))
	    (insert "\n\n")
	    (move-to-column cobol-column t)
	    (insert " WHEN  \n\n")
	    (move-to-column cobol-column t)
	    (insert " WHEN OTHER \n")
	    (setq cobol-column
		  (+ cobol-column 3))
	    (move-to-column cobol-column t)
	    (insert " CONTINUE \n")
	    (setq cobol-column
		  (- cobol-column 3))
	    (move-to-column cobol-column t)
	    (insert " END-EVALUATE")
	    (goto-char cursor)))))))

					; RF03.05, RB03.05
					;2.5.5 insert-construct
(defun cobol-insert-read-next ()
"Insert the construct READ file NEXT
                     AT END
                     NOT AT END
                     END-READ
at current line, ask for the file and check the presence of the file by
\\[cobol-insert-read-next]."
  (interactive)
  (let
      ( (break nil) end-line file cobol-string
	(position (point))(length 0))
    (cobol-search-procedure)
    (if (= cobol-buffer-limit 0)
	(goto-char position)
      (progn
	(end-of-line)
	(setq end-line (point))
	(beginning-of-line)
	(if (re-search-forward "[^ \\|\n]" end-line t)
	    (cobol-message "Insert construct in empty lines only!" nil)
	(progn
	  (while (string= "nil" break)
	    (cobol-minibuffer-input
	     "FILE:" "FILE")
	    (setq file cobol-string)
	    (if (search-backward " FILE-CONTROL" nil t)
		(if (re-search-forward
		     (concat "SELECT[^a-z]*" file " ") cobol-buffer-limit t)
		    (progn
		      (setq break "t")
		      (goto-char position))
		  (progn
		    (cobol-message "File %s not found!" file)
		    (goto-char position)))
	      (cobol-message "FILE CONTROL not found!" nil)))
	  (setq length (+ (length file) 11))
	  (cobol-indent length position)
	  (move-to-column cobol-column t)
	  (insert " READ ")
	  (move-to-column (+ cobol-column 6) t)
	  (insert (concat file " NEXT\n"))
	  (move-to-column cobol-column t)
	  (insert " AT END \n")
	  (move-to-column (+ cobol-column 4) t)
	  (setq cursor (point))
	  (insert "\n")
	  (move-to-column cobol-column t)
	  (insert " NOT AT END\n")
	  (move-to-column (+ cobol-column 4) t)
	  (insert "CONTINUE\n")
	  (move-to-column cobol-column t)
	  (insert " END-READ")
	  (goto-char cursor)))))))

					; RF03.05, RB03.05
					;2.5.5 insert-construct
(defun cobol-insert-read-key ()
"Insert the construct READ file
                     INVALID
                     NOT INVALID
                     END-READ
at current line, ask for the file and check the presence of the file by
\\[cobol-insert-read-key]."
  (interactive)
  (let
      ((break nil) end-line cobol-string
       (position (point)) file (length 0))
    (cobol-search-procedure)
    (if (= cobol-buffer-limit 0)
	(goto-char position)
      (progn
	(end-of-line)
	(setq end-line (point))
	(beginning-of-line)
	(if (re-search-forward "[^ \\|\n]" end-line t)
	    (cobol-message "Insert construct in empty lines only!" nil)
	  (progn
	    (while (string= "nil" break)
	      (cobol-minibuffer-input
	       "FILE:" "FILE")
	      (setq file cobol-string)
	      (if (search-backward " FILE-CONTROL" nil t)
		  (if (re-search-forward
		       (concat "SELECT[^a-z]*" file " ") cobol-buffer-limit t)
		      (progn
			(setq break "t")
			(goto-char position))
		    (progn
		      (cobol-message "File %s not found!" file)
		      (goto-char position)))
		(cobol-message "FILE CONTROL not found!" nil)))
	    (setq length (+ (length file) 10))
	    (cobol-indent length position)
	    (move-to-column cobol-column t)
	    (insert " READ ")
	    (move-to-column (+ cobol-column 6) t)
	    (insert (concat file "\n"))
	    (move-to-column cobol-column t)
	    (insert " INVALID \n")
	    (move-to-column (+ cobol-column 4) t)
	    (setq cursor (point))
	    (insert "\n")
	    (move-to-column cobol-column t)
	    (insert " NOT INVALID\n")
	    (move-to-column (+ cobol-column 4) t)
	    (insert "CONTINUE\n")
	    (move-to-column cobol-column t)
	    (insert " END-READ")
	    (goto-char cursor)))))))

					; RF03.05, RB03.05
					; 2.5.5 insert-construct
(defun cobol-add-rewrite ()
"Insert the construct REWRITE record
                     INVALID
                     END-REWRITE
at current line, ask for the record and check the presence of the record by
\\[cobol-add-rewrite]."
  (interactive)
  (let
      ((break nil) end-line cobol-string
       (position (point)) record (length 0))
    (cobol-search-procedure)
    (if (= cobol-buffer-limit 0)
	(goto-char position)
      (progn
	(end-of-line)
	(setq end-line (point))
	(beginning-of-line)
	(if (re-search-forward "[^ \\|\n]" end-line t)
	    (cobol-message "Insert construct in empty lines only!" nil)
	  (progn
	    (while (string= "nil" break)
	      (cobol-minibuffer-input
	       "RECORD:" "RECORD")
	      (setq record cobol-string)
	      (goto-char position)
	      (if (search-backward " FILE SECTION" nil t)
		  (if (re-search-forward
		       (concat "\\([^*][0-9][0-9][^a-z]+"
			       record "[\.]\\)") cobol-buffer-limit t)
		      (progn
			(setq break "t")
			(other-window 1)
			(goto-char position)
			(delete-other-windows))
		    (progn
		      (switch-to-buffer-other-window(buffer-name))
		      (goto-char position)
		      (other-window 1)
		      (cobol-message "RECORD %s not found!" record)))
		(cobol-message "FILE SECTION not found!" nil)))
	    (setq length (+ (length record) 8))
	    (cobol-indent length position)
	    (move-to-column cobol-column t)
	    (insert " REWRITE ")
	    (move-to-column (+ cobol-column 9) t)
	    (insert (concat record "\n"))
	    (move-to-column cobol-column t)
	    (insert " INVALID \n")
	    (move-to-column (+ cobol-column 4) t)
	    (setq cursor (point))
	    (insert "\n")
	    (move-to-column cobol-column t)
	    (insert " END-REWRITE")
	    (goto-char cursor)))))))

					; RF03.05, RB03.05
					; 2.5.5 insert-construct
(defun cobol-add-write ()
"Insert the construct WRITE record
                     INVALID
                     END-WRITE
at current line, ask for the record and check the presence of the record by
\\[cobol-add-write]."
  (interactive)
  (let
      ((break nil) end-line cobol-string
       (position (point)) record (length 0))
    (cobol-search-procedure)
    (if (= cobol-buffer-limit 0)
	(goto-char position)
      (progn
	(end-of-line)
	(setq end-line (point))
	(beginning-of-line)
	(if (re-search-forward "[^ \\|\n]" end-line t)
	    (cobol-message "Insert construct in empty lines only!" nil)
	  (progn
	    (while (string= "nil" break)
	      (cobol-minibuffer-input
	       "RECORD:" "RECORD")
	      (setq record cobol-string)
	      (goto-char position)
	      (if (search-backward " FILE SECTION" nil t)
		  (if (re-search-forward
		       (concat "\\([^*][0-9][0-9][^a-z]+"
			       record "[\.]\\)") cobol-buffer-limit t)
		      (progn
			(setq break "t")
			(other-window 1)
			(goto-char position)
			(delete-other-windows))
		    (progn
		      (switch-to-buffer-other-window(buffer-name))
		      (goto-char position)
		      (other-window 1)
		      (cobol-message "RECORD %s not found!" record)))
		(cobol-message "FILE SECTION not found!" nil)))
	  (setq length (+ (length record) 8))
	    (cobol-indent length position)
	    (move-to-column cobol-column t)
	    (insert " WRITE ")
	    (move-to-column (+ cobol-column 7) t)
	    (insert (concat record "\n"))
	    (move-to-column cobol-column t)
	    (insert " INVALID \n")
	    (move-to-column (+ cobol-column 4) t)
	    (setq cursor (point))
	    (insert "\n")
	    (move-to-column cobol-column t)
	    (insert " END-WRITE")
	    (goto-char cursor)))))))

					; RF03.05, RB03.05
					; 2.5.5 insert-construct
(defun cobol-add-delete ()
"Insert the construct DELETE file
                     INVALID
                     END-DELETE
at current line, ask for the file and check the presence of the file by
\\[cobol-add-delete]."
  (interactive)
  (let
      ((break nil) end-line cobol-string
       (position (point)) file (length 0))
    (cobol-search-procedure)
    (if (= cobol-buffer-limit 0)
	(goto-char position)
      (progn
	(end-of-line)
	(setq end-line (point))
	(beginning-of-line)
	(if (re-search-forward "[^ \\|\n]" end-line t)
	    (cobol-message "Insert construct in empty lines only!" nil)
	  (progn
	    (while (string= "nil" break)
	      (cobol-minibuffer-input
	       "FILE:" "FILE")
	      (setq file cobol-string)
	      (if (search-backward " FILE-CONTROL" nil t)
		  (if (re-search-forward
		       (concat "SELECT[^a-z]*" file " ") cobol-buffer-limit t)
		      (progn
			(setq break "t")
			(goto-char position))
		    (progn
		      (cobol-message "File %s not found!" file)
		      (goto-char position)))
		(cobol-message "FILE CONTROL not found!" nil)))
	    (setq length (+ (length file) 9))
	    (cobol-indent length position)
	    (move-to-column cobol-column t)
	    (insert " DELETE ")
	    (move-to-column (+ cobol-column 8) t)
	    (insert (concat file "\n"))
	    (move-to-column cobol-column t)
	    (insert " INVALID \n")
	    (move-to-column (+ cobol-column 4) t)
	    (setq cursor (point))
	    (insert "\n")
	    (move-to-column cobol-column t)
	    (insert " END-DELETE")
	    (goto-char cursor)))))))

					; RF03.05, RB03.05
					; 2.5.5 insert-construct
(defun cobol-add-start ()
"Insert the construct START file KEY IS expression
                     INVALID
                     NOT INVALID
                     END-START
at current line, ask for the file and key and check the
presence of the file by \\[cobol-add-start]."
  (interactive)
  (let
      ((break nil) end-line file key cobol-string
       (position (point))(length 0))
    (cobol-search-procedure)
    (if (= cobol-buffer-limit 0)
	(goto-char position)
      (progn
	(end-of-line)
	(setq end-line (point))
	(beginning-of-line)
	(if (re-search-forward "[^ \\|\n]" end-line t)
	    (cobol-message "Insert construct in empty lines only!" nil)
	  (progn
	    (while (string= "nil" break)
	      (cobol-minibuffer-input
	       "FILE:" "FILE")
	      (setq file cobol-string)
	      (if (search-backward " FILE-CONTROL" nil t)
		  (if (re-search-forward
		       (concat "SELECT[^a-z]*" file " ") cobol-buffer-limit t)
		      (progn
			(setq break "t")
			(goto-char position))
		    (progn
		      (cobol-message "File %s not found!" file)
		      (goto-char position)))
		(cobol-message "FILE CONTROL not found!" nil)))
	    (cobol-minibuffer-input
	     "KEY IS{=;>;NOT<;>=;<;not>;<=}:" "KEY")
	    (setq key cobol-string)
	    (setq length
		  (+ (length file) (+ (length key) 15)))
	    (cobol-indent length position)
	    (move-to-column cobol-column t)
	    (insert " START ")
	    (move-to-column (+ cobol-column 7) t)
	    (insert (concat file " KEY IS "))
	    (move-to-column (+ cobol-column (+ (length key) 18)))
	    (insert (concat key "\n"))
	    (move-to-column cobol-column t)
	    (insert " INVALID\n")
	    (move-to-column (+ cobol-column 4) t)
	    (setq cursor (point))
	    (insert "\n")
	    (move-to-column cobol-column t)
	    (insert " NOT INVALID\n")
	    (move-to-column (+ cobol-column 4) t)
	    (insert "CONTINUE\n")
	    (move-to-column cobol-column t)
	    (insert " END-START")
	    (goto-char cursor)))))))

					; RF03.06, RB03.06
					; 2.5.5 insert-construct
(defun cobol-add-add ()
"Insert the construct ADD identifier1 TO identifier2
                     ON SIZE ERROR
                     END-ADD
at current line and ask for identifier1 and identifier2 by
\\[cobol-add-add]."
  (interactive)
  (let
      ((break nil)end-line
       identifier1 identifier2 (position (point))(length 0))
    (cobol-search-procedure)
    (if (= cobol-buffer-limit 0)
	(goto-char position)
      (progn
	(end-of-line)
	(setq end-line (point))
	(beginning-of-line)
	(if (re-search-forward "[^ \\|\n]" end-line t)
	    (cobol-message "Insert construct in empty lines only!" nil)
	(progn
	  (setq identifier1
		(read-from-minibuffer "Identifier1:"))
	  (setq identifier2
		(read-from-minibuffer "Identifier2:"))
	  (setq length
		(+ (length identifier2) (+ (length identifier1) 11)))
	  (cobol-indent length position)
	  (move-to-column cobol-column t)
	  (insert " ADD ")
	  (move-to-column (+ cobol-column 5) t)
	  (insert (concat identifier1 " TO "))
	  (move-to-column (+ cobol-column (+ (length identifier1) 9)))
	  (insert (concat identifier2 "\n"))
	  (move-to-column cobol-column t)
	  (insert " ON SIZE ERROR\n")
	  (move-to-column (+ cobol-column 4) t)
	  (setq cursor (point))
	  (insert "\n")
	  (move-to-column cobol-column t)
	  (insert " END-ADD")
	  (goto-char cursor)))))))

					; RF03.06, RB03.06
					; 2.5.5 insert-construct
(defun cobol-add-divide ()
"Insert the construct DIVIDE identifier1 INTO identifier2
                     ON SIZE ERROR
                     END-DIVIDE
at current line and ask for identifier1 and identifier2 by
\\[cobol-add-divide]."
  (interactive)
  (let
      (end-line identifier1 identifier2 (position (point))(length 0))
    (cobol-search-procedure)
    (if (= cobol-buffer-limit 0)
	(goto-char position)
      (progn
	(end-of-line)
	(setq end-line (point))
	(beginning-of-line)
	(if (re-search-forward "[^ \\|\n]" end-line t)
	    (cobol-message "Insert construct in empty lines only!" nil)
	(progn
	  (setq identifier1
		(read-from-minibuffer "Identifier1:"))
	  (setq identifier2
		(read-from-minibuffer "Identifier2:"))
	  (setq length
		(+ (length identifier2) (+ (length identifier1) 13)))
	  (cobol-indent length position)
	  (move-to-column cobol-column t)
	  (insert " DIVIDE")
	  (move-to-column (+ cobol-column 8) t)
	  (insert (concat identifier1 " INTO "))
	  (move-to-column (+ cobol-column (+ (length identifier1) 14)))
	  (insert (concat identifier2 "\n"))
	  (move-to-column cobol-column t)
	  (insert " ON SIZE ERROR\n")
	  (move-to-column (+ cobol-column 4) t)
	  (setq cursor (point))
	  (insert "\n")
	  (move-to-column cobol-column t)
	  (insert " END-DIVIDE")
	  (goto-char cursor)))))))

					; RF03.06, RB03.06
					; 2.5.5 insert-construct
(defun cobol-add-subtract ()
"Insert the construct SUBTRACT identifier1 FROM identifier2
                     ON SIZE ERROR
                     END-SUBTRACT
at current line and ask for identifier1 and identifier2 by
\\[cobol-add-subtract]."
  (interactive)
  (let
      (end-line identifier1 identifier2 (position (point))(length 0))
    (cobol-search-procedure)
    (if (= cobol-buffer-limit 0)
	(goto-char position)
      (progn
	(end-of-line)
	(setq end-line (point))
	(beginning-of-line)
	(if (re-search-forward "[^ \\|\n]" end-line t)
	    (cobol-message "Insert construct in empty lines only!" nil)
	(progn
	  (setq identifier1
		(read-from-minibuffer "Identifier1:"))
	  (setq identifier2
		(read-from-minibuffer "Identifier2:"))
	  (setq length
		(+ (length identifier2) (+ (length identifier1) 15)))
	  (cobol-indent length position)
	  (move-to-column cobol-column t)
	  (insert " SUBTRACT")
	  (move-to-column (+ cobol-column 10) t)
	  (insert (concat identifier1 " FROM "))
	  (move-to-column (+ cobol-column (+ (length identifier1) 16)))
	  (insert (concat identifier2 "\n"))
	  (move-to-column cobol-column t)
	  (insert " ON SIZE ERROR\n")
	  (move-to-column (+ cobol-column 4) t)
	  (setq cursor (point))
	  (insert "\n")
	  (move-to-column cobol-column t)
	  (insert " END-SUBTRACT")
	  (goto-char cursor)))))))

					; RF03.06, RB03.06
					; 2.5.5 insert-construct
(defun cobol-add-multiply ()
"Insert the construct MULTIPLY identifier1 BY identifier2
                     ON SIZE ERROR
                     END-MULTIPLY
at current line and ask for identifier1 and identifier2 by
\\[cobol-add-multiply]."
  (interactive)
  (let
      (end-line identifier1 identifier2 (position (point))(length 0))
    (cobol-search-procedure)
    (if (= cobol-buffer-limit 0)
	(goto-char position)
      (progn
	(end-of-line)
	(setq end-line (point))
	(beginning-of-line)
	(if (re-search-forward "[^ \\|\n]" end-line t)
	    (cobol-message "Insert construct in empty lines only!" nil)
	(progn
	  (setq identifier1
		(read-from-minibuffer "Identifier1:"))
	  (setq identifier2
		(read-from-minibuffer "Identifier2:"))
	  (setq length
		(+ (length identifier2) (+ (length identifier1) 15)))
	  (cobol-indent length position)
	  (move-to-column cobol-column t)
	  (insert " MULTIPLY")
	  (move-to-column (+ cobol-column 10) t)
	  (insert (concat identifier1 " BY "))
	  (move-to-column (+ cobol-column (+ (length identifier1) 14)))
	  (insert (concat identifier2 "\n"))
	  (move-to-column cobol-column t)
	  (insert " ON SIZE ERROR\n")
	  (move-to-column (+ cobol-column 4) t)
	  (setq cursor (point))
	  (insert "\n")
	  (move-to-column cobol-column t)
	  (insert " END-MULTIPLY")
	  (goto-char cursor)))))))

					; RF03.06, RB03.06
					; 2.5.5 insert-construct
(defun cobol-add-compute ()
"Insert the construct COMPUTE identifier = expression
                     ON SIZE ERROR
                     END-COMPUTE
at current line and ask for identifier and expression by
\\[cobol-add-compute]."
  (interactive)
  (let
      (end-line identifier expression (position (point))(length 0))
    (cobol-search-procedure)
    (if (= cobol-buffer-limit 0)
	(goto-char position)
      (progn
	(end-of-line)
	(setq end-line (point))
	(beginning-of-line)
	(if (re-search-forward "[^ \\|\n]" end-line t)
	    (cobol-message "Insert construct in empty lines only!" nil)
	(progn
	  (setq identifier
		(read-from-minibuffer "Identifier:"))
	  (setq expression
		(read-from-minibuffer "Expression:"))
	  (setq length
		(+ (length identifier) (+ (length expression) 13)))
	  (cobol-indent length position)
	  (move-to-column cobol-column t)
	  (insert " COMPUTE")
	  (move-to-column (+ cobol-column 9) t)
	  (insert (concat identifier " = "))
	  (move-to-column (+ cobol-column (+ (length identifier) 12)))
	  (insert (concat expression "\n"))
	  (move-to-column cobol-column t)
	  (insert " ON SIZE ERROR\n")
	  (move-to-column (+ cobol-column 4) t)
	  (setq cursor (point))
	  (insert "\n")
	  (move-to-column cobol-column t)
	  (insert " END-COMPUTE")
	  (goto-char cursor)))))))

					; RF04.01, RB04.01
					; 2.3.3 cobol-indent
(defun cobol-indent (len position)
   (let
       ((max 0) construct (count 0)
	(cursor (point))
	(end
	 (length cobol-construct-list))
	(step 0) (comp 1))
     (setq cobol-column 10)
     (setq cobol-max-list (list 0 ))
     (if (or(search-backward cobol-section cobol-buffer-limit t)
	    (search-backward cobol-begin cobol-buffer-limit t))
	 (setq stop (point))
       (setq stop cobol-buffer-limit))
     (goto-char cursor)
     (while (not (= step end))
       (setq construct
	     (nth step cobol-construct-list))
       (setq step (+ step 1))
       (cobol-search-construct construct stop)
       (goto-char cursor))
     (setq step 0)
     (setq cobol-max-list
	   (reverse cobol-max-list))
     (while (not (> step end))
       (setq max
	     (nth step cobol-max-list))
       (if (> max comp)
	   (progn
	     (setq comp max)
	     (setq count step)))
       (setq step (+ step 1)))
     (if (not (= comp 1))
	 (progn
	   (goto-char comp)
	   (setq cobol-column
		 (+ (current-column)
		    (nth count cobol-position-list))))
       (setq cobol-column 10))
     (if (> (+ cobol-column len) 70)
	 (if (= (nth count cobol-position-list) 99)
	     (if (re-search-backward cobol-arrowl cobol-buffer-limit t)
		 (cobol-indent length position)
	       (cobol-message "I miss *<---- !"  nil))
	   (progn
	     (goto-char position)
	     (move-to-column 6 t)
	     (insert "*<---- \n")
	     (setq position (point))
	     (insert "\n")
	     (move-to-column 6 t)
	     (insert "*---->")
	     (goto-char position)
	     (setq cobol-column 10)))
       (goto-char position))))

					; RF04.02, RB04.02
					; 2.3.4 indent-cursor
(defun cobol-indent-cursor ()
(interactive)
"Above PROCEDURE DIVISION the function generates the TAB-stops:
8, 12, 16, 20, 24, 28,..., 56.
Within PROCEDURE DIVISION TAB indents the current cobol line
in accordance to the paradigm of structured programming
\\[cobol-indent-cursor]."
(let
    ((cursor (point)))
(if (search-forward cobol-procedure-division nil t)
	(cobol-indent-cursor-before-pd)
  (cobol-indent-cursor-behind-pd))))

					; RF0402,
					; 2.3.5 indent-cursor-before-pd
(defun cobol-indent-cursor-before-pd ()
  (goto-char cursor)
  (cond
   ((and ( > (current-column) 0)
	 ( < (current-column) 7))
    (move-to-column 7 t))
   ((and ( >= (current-column) 7)
	 ( <  (current-column) 11))
    (move-to-column 11 t))
   ((and ( >= (current-column) 11)
	 ( <  (current-column) 15))
    (move-to-column 15 t))
   ((and ( >= (current-column) 15)
	 ( <  (current-column) 19))
    (move-to-column 19 t))
   ((and ( >= (current-column) 19)
	 ( <  (current-column) 23))
    (move-to-column 23 t))
   ((and ( >= (current-column) 23)
	 ( <  (current-column) 27))
    (move-to-column 27 t))
   ((and ( >= (current-column) 27)
	 ( <  (current-column) 31))
    (move-to-column 31 t))
   ((and ( >= (current-column) 31)
	 ( <  (current-column) 35))
    (move-to-column 35 t))
   ((and ( >= (current-column) 35)
	 ( <  (current-column) 39))
    (move-to-column 39 t))
   ((and ( >= (current-column) 39)
	 ( <  (current-column) 43))
    (move-to-column 43 t))
   ((and ( >= (current-column) 43)
	 ( <  (current-column) 47))
    (move-to-column 47 t))
   ((and ( >= (current-column) 47)
	 ( <  (current-column) 51))
    (move-to-column 51 t))
   ((and ( >= (current-column) 51)
	 ( <  (current-column) 55))
    (move-to-column 55 t))
   (t ( >= (current-column) 55)
      (move-to-column 7 t))))

					; RF04.02, RB04.02
					; 2.3.6 indent-cursor-behind-pd
(defun cobol-indent-cursor-behind-pd ()
  (let
      (region end col posnew (length 0)
       stop max word beg
       found (count-word 0)
       (count-word-end 1))
    (goto-char cursor)
    (next-line -1)
    (end-of-line)
    (cobol-indent length cursor)
    (end-of-line)
    (setq end (point))
    (beginning-of-line)
    (if (not (re-search-forward "[^ ]" end t))
	(move-to-column (+ cobol-column 1)t)
      (progn
	(move-to-column (+ cobol-column 1)t)
	(setq col (point))
	(end-of-line)
	(backward-sexp)
	(forward-sexp)
	(setq end (point))
	(back-to-indentation)
	(if (looking-at "*")
	    (progn
	      (backward-char 1)
	      (setq posnew (point))
	      (forward-sexp)
	      (setq stop (point)))
	  (progn
	    (forward-sexp)
	    (setq stop (point))
	    (backward-sexp)
	    (setq posnew (point))))
	(setq word
	      (buffer-substring posnew stop))
	(setq region
	      (buffer-substring posnew end))
	(if (< (length word) 4)
	    (setq word (concat word "    ")))
	(cond
	 ((string= "*" (substring word 0 1))
	  (progn
	    (setq cobol-column 5)
	    (move-to-column 5 t)
	    (setq col (point))
	    (goto-char posnew)))
	 ((or (string= "ANFANG-S1." word )
	      (string= "anfang-s1." word )
	      (string= "ANFANG." word)
	      (string= "anfang." word)
	      (string= "ENDE-S1." word)
	      (string= "ende-s1." word))
	  (progn
	    (setq cobol-column 6)
	    (move-to-column 6 t)
	    (setq col (point))
	    (goto-char posnew)))
	 ((or (string= "NOT    " word)
	      (string= "not    " word))
	  (progn
	    (goto-char stop)
	    (forward-sexp)
	    (setq stop (point))
	    (backward-sexp)
	    (setq word (buffer-substring (point) stop))
	    (cond
	     ((or(string= "INVALID" word)
		 (string= "invalid" word))
	        (cobol-corresponding cobol-invalid cobol-not-invalid)
		(if (= count-word count-word-end)
		    (progn
		      (goto-char found)
		      (backward-sexp 1)
		      (setq cobol-column
			    (- (current-column) 1))
		      (goto-char cursor)
		      (move-to-column (+ cobol-column 1)t)
		      (setq col (point))
		      (goto-char posnew))
		  (progn
		    (goto-char cursor)
		    (cobol-message "I miss 'INVALID'!" nil))))
	     ((or(string= "AT" word)
		 (string= "at" word))
		 (cobol-corresponding cobol-read cobol-end-read)
		 (if (= count-word count-word-end)
		     (progn
		       (goto-char found)
		       (backward-sexp 1)
		       (setq cobol-column
			     (- (current-column) 1))
		       (goto-char cursor)
		       (move-to-column (+ cobol-column 1)t)
		       (setq col (point))
		       (goto-char posnew))
		   (progn
		     (goto-char cursor)
		     (cobol-message "I miss 'AT END'!" nil))))
	     ((or(string= "ON" word)
		 (string= "on" word))
	      (cobol-corresponding
	       cobol-on-size-error cobol-not-on-size-error)
	    (if (= count-word count-word-end)
		(progn
		  (goto-char found)
		  (backward-sexp 3)
		  (setq cobol-column
			(- (current-column) 1))
		  (goto-char cursor)
		  (move-to-column (+ cobol-column 1)t)
		  (setq col (point))
		  (goto-char posnew))
	      (progn
		(goto-char cursor)
		(cobol-message "I miss 'ON SIZE ERROR'!" nil)))))))
	 ((or (string= "ELSE" word)
	      (string= "else" word)
	      (string= "then" word)
	      (string= "THEN" word))
	  (progn
	    (cobol-corresponding cobol-if cobol-end-if)
	    (if (= count-word count-word-end)
		(progn
		  (goto-char found)
		  (backward-sexp 1)
		  (setq cobol-column
			(- (current-column) 1))
		  (goto-char cursor)
		  (move-to-column (+ cobol-column 1)t)
		  (setq col (point))
		  (goto-char posnew))
	      (progn
		(goto-char cursor)
		(cobol-message "I miss 'IF'!" nil)))))
	 ((or(string= "WHEN" word)
	     (string= "when" word))
	  (progn
	    (cobol-corresponding cobol-evaluate
				 cobol-end-evaluate)
	    (if (= count-word count-word-end)
		(progn
		  (goto-char found)
		  (backward-sexp 1)
		  (setq cobol-column
			(-(current-column) 1))
		  (goto-char cursor)
		  (move-to-column (+ cobol-column 1)t)
		  (setq col (point))
		  (goto-char posnew))
	      (progn
		(goto-char cursor)
		(cobol-message "I miss 'EVALUATE'!" nil)))))
	 ((or (string= "END-" (substring word 0 4))
	      (string= "end-" (substring word 0 4)))
	  (progn
	    (setq beg (concat " " (substring word 4)))
	    (if (or(string= " perform" beg)
		   (string= " PERFORM" beg))
		(setq beg cobol-perform-until))
	    (cobol-corresponding beg word)
	    (if (= count-word count-word-end)
		(progn
		  (goto-char found)
		  (if(string= beg cobol-perform-until)
		      (progn
			(beginning-of-line)
			(setq limit (point))
			(end-of-line)
			(search-backward "perform" limit t))
		    (backward-sexp 1))
		  (setq cobol-column
			(-(current-column) 1))
		  (goto-char cursor)
		  (move-to-column (+ cobol-column 1)t)
		  (setq col (point))
		  (goto-char posnew))
	      (progn
		(goto-char cursor)
		(cobol-message "There is no start for for the end-construct!" nil))))))
	(if (> posnew col)
	    (progn
	      (beginning-of-line)
	      (kill-line)
	      (move-to-column (+ cobol-column 1)t)
	      (insert region)
	      (move-to-column (+ cobol-column 1)t))
	  (indent-to
	   (+ cobol-column 1)))))))

					; 2.3.1 search-procedure
(defun cobol-search-procedure ()
  (let (linelimit
	(cursor (point)))
  (if (search-backward cobol-procedure-division nil t)
      (progn
	(end-of-line)
	(setq linelimit (point))
	(move-to-column 6 t)
	(if (or (looking-at "*")
		(re-search-forward cobol-display linelimit t))
	    (cobol-search-procedure)
	  (progn
	  (setq cobol-buffer-limit (point))
	  (goto-char cursor))))
    (progn
      (setq cobol-buffer-limit 0)
      (cobol-message "You are not within PROCEDURE DIVISION!" nil)))))

					; RF04.01, RB04.01
					; 2.3.2 search-construct
(defun cobol-search-construct (construct stop)
 (let
     (linelimit cursor)
  (if (re-search-backward construct stop t)
      (progn
	(setq cursor (point))
	(beginning-of-line)
	(setq linelimit (point))
	(goto-char cursor)
	(if (re-search-backward "[^ ]" linelimit t)
	    (cobol-search-construct construct stop)
	  (setq cobol-max-list
		(cons cursor cobol-max-list))))
   (setq cobol-max-list
	 (cons (point-min) cobol-max-list)))))

					; RF05, RB05
					; 2.3.7 return
(defun cobol-return ()
(interactive)
  (let
      (word alt-col new-col end-line
	    w-end w-beg
	    w-until until-end alt-col)
    (setq alt-col (point))
    (end-of-line)
    (setq end-line (point))
    (goto-char alt-col)
    (if (re-search-forward "[^ \\|\n]" end-line t)
	(progn
	  (backward-char 1)
	  (setq alt-col (point))))
    (back-to-indentation)
    (if (not (looking-at "*"))
	(progn
	  (beginning-of-line)
	  (forward-sexp 1)
	  (setq w-end (point))
	  (backward-sexp 1)
	  (setq w-beg (point))
	  (setq word
		(buffer-substring w-beg w-end))
	  (cond
	   ((or (and (string-equal "IF" word)
		       (> alt-col w-end))
		  (and (string-equal "if" word)
		       (> alt-col w-end))
		  (and (string-equal "EVALUATE" word)
		       (> alt-col w-end))
		  (and (string-equal "evaluate" word)
		       (> alt-col w-end))
		  (and (string-equal "WHEN" word)
		       (> alt-col w-end))
		  (and (string-equal "when" word)
		       (> alt-col w-end)))
	      (progn
		(forward-sexp 2)
		(backward-sexp 1)))
	   ((or (and (string-equal "CALL" word)
			(> alt-col w-end))
		   (and (string-equal "call" word)
			(> alt-col w-end)))
	      (progn
		(forward-sexp 4)
		(backward-sexp 1)))
	   ((or (and (string-equal "PERFORM" word)
			(> alt-col w-end))
		   (and (string-equal "perform" word)
			(> alt-col w-end)))
	      (progn
		(forward-sexp 2)
		(setq until-end (point))
		(backward-sexp 1)
		(setq w-until
		      (buffer-substring (point) until-end))
		(cond
		 ((or (string-equal "UNTIL" w-until)
		      (string-equal "until" w-until))
		  (progn (forward-sexp 2)
			 (backward-sexp 1)))
		 ((or (string-equal "TEST" w-until)
		      (string-equal "test" w-until))
		  (progn (forward-sexp 4)
			 (backward-sexp 1)))
		 ((or (string-equal "WITH" w-until)
		      (string-equal "with" w-until))
		  (progn
		    (forward-sexp 5)
		    (backward-sexp 1))))))
	   ((or (and (string-equal "PROCEDURE" word)
		     (> alt-col w-end))
		(and (string-equal "procedure" word)
		     (> alt-col w-end)))
	    (progn
	      (forward-sexp 3)
	      (setq until-end (point))
	      (backward-sexp 1)
	      (setq w-until
		    (buffer-substring (point) until-end))
	      (if (or (string-equal "USING" w-until)
		      (string-equal "using" w-until))
		  (progn
		    (forward-sexp 2)
		    (backward-sexp 1))))))))
    (setq new-col (current-column))
    (goto-char alt-col)
    (newline)
    (indent-to-column new-col)))

					; RF06, RB06
					; 2.5.6 column-display
(defun cobol-column-display ()
(interactive)
"Show a temporary column display, removed by typing any key, by
\\[cobol-column-display]."
(if (string-equal "Line 1" (what-line))
    (cobol-message "You are in the first line, go to the next one!" nil)
  (progn
    (momentary-string-display
     cobol-column-display
     (save-excursion (beginning-of-line) (point)) nil))))

					; RF03.08, RB03.08
					; 2.5.7 insert-comment
(defun cobol-add-comment ()
  (interactive)
"Insert a comment in column 7 by
\\[cobol-add-comment]."
  (move-to-column 6 t)
  (insert "*"))

					; RF03.09, RB03.09
					; 2.5.13 abbrev-begin
(defun cobol-abbrev-begin ()
  (interactive)
"Expand the abbreviations behind a semicolon.
 Type ';?' to display a list of built-in abbrevs for COBOL keywords."
  (let
      (abbrev position
       (cursor-beg (point)))
    (insert last-command-char)
    (if (> (current-column) 12)
	(progn
	  (setq cursor-beg (point))
	  (back-to-indentation)
	  (if (looking-at "[;]")
	      (progn
		(setq position (point))
		(cobol-indent 0 position)
		(delete-char 1)
		(move-to-column (+ cobol-column 1) t)
		(insert ";"))
	    (goto-char cursor-beg))))
    (if (or (= (setq abbrev (read-char)) ??)
	    (= abbrev help-char))
	(cobol-abbrev-help)
      (setq unread-command-char abbrev))))

					; RF03.09, RB03.09
					; 2.5.14 abbrev-help
(defun cobol-abbrev-help ()
  (let
      (beg end reverse)
    (setq list-abbrev-help '())
    (message "Listing abbrev table...")
    (list-abbrevs)
    (message "Listing abbrev table...done")
    (other-window 1)
    (goto-char 1)
    (next-line 1)
    (setq beg (point))
    (while (re-search-forward "[\"]" nil t)
      (next-line 1))
    (setq end (point))
    (setq reverse nil)
    (goto-char 1)
    (sort-lines reverse beg end)))

					; RF03.02.01, RB03.02.01
					; 2.2.1 list-variable
(defun cobol-list-variable ()
  (interactive)
"Check the presence of a variable and show it's declaration by
\\[cobol-list-variable]. If the variable does not exist, similar variables
will be shown."
  (let
      (var (cursor (point))
	   var-beg var-end
	   var-length)
    (cobol-search-procedure)
    (if (not (= cobol-buffer-limit 0))
	(progn
	  (setq buffer (buffer-name))
	  (forward-sexp 1)
	  (setq var-end (point))
	  (backward-sexp 1)
	  (setq var-beg (point))
	  (setq var
		(buffer-substring var-beg var-end))
	  (setq var-length (length var))
	  (switch-to-buffer-other-window buffer)
	  (goto-char 1)
	  (if (not (re-search-forward
		    (concat "\\([^*][0-9][0-9][^a-z]+" var "[^a-z]\\)")
		    cobol-buffer-limit t))
	      (progn
		(if (not (get-buffer "-VARIABLE-"))
		    (generate-new-buffer "-VARIABLE-")
		  (progn
		    (kill-buffer "-VARIABLE-")
		    (generate-new-buffer "-VARIABLE-")))
		(if (search-forward cobol-working-storage-section nil t)
		    (progn
		      (cobol-similar-variable)
		      (switch-to-buffer "-VARIABLE-")
		      (switch-to-buffer-other-window buffer)
		      (other-window 1)
		      (message "variable not found, take one of these!")
		      (if (= (point-min)(point-max))
			  (progn
			    (kill-buffer "-VARIABLE-")
			    (other-window 1)
			    (delete-other-windows)
			    (goto-char cursor)
			    (cobol-message "I've never seen such a variable" nil))
			(progn
			  (other-window 1)
			  (goto-char cursor))))
		  (cobol-message "WORKING-STORAGE SECTION not found" nil)))
	    (progn
	      (sit-for 2)
	      (other-window 1)))))))

					; RF03.02.02, RB03.02.02
					; 2.2.2 similar-variable
(defun cobol-similar-variable ()
  (let
      (subvar subvar-first
	      subvar-second
	      (pointer 1) beg end similar)
    (if (< var-length 5)
	(progn
	  (while (not (> pointer var-length))
	    (progn
	      (setq subvar-first
		    (substring var pointer var-length))
	      (setq subvar-second
		    (substring var 0 (- pointer 1)))
	      (setq subvar
		    (concat subvar-second "." subvar-first))
	      (if (re-search-forward
		  (concat "\\([^*][0-9][0-9][^a-z]+" subvar "[^a-z]\\)")
		   cobol-buffer-limit t)
		  (progn
		    (backward-sexp 1)
		    (setq beg (point))
		    (forward-sexp 1)
		    (setq end (point))
		    (setq similar
			  (buffer-substring beg end))
		    (switch-to-buffer "-VARIABLE-")
		    (goto-char 1)
		    (if (not (re-search-forward
			      (concat "\\<" similar "\\>") nil t))
			(progn
			  (goto-char (point-max))
			  (insert (concat similar "\n"))))
		    (setq similar " ")
		    (switch-to-buffer buffer))
		(progn
		  (setq pointer (+ pointer 1))
		  (goto-char 1))))))
      (progn
	(while (< (+ pointer 1) var-length)
	  (progn
	    (setq subvar (substring var
				    ( - pointer 1) (+ pointer 2)))
	    (if (re-search-forward
		 (concat "[^*][0-9][0-9][a-z -]*" subvar)
	      cobol-buffer-limit t)
		(progn
		  (backward-sexp 1)
		  (setq beg (point))
		  (forward-sexp 1)
		  (setq end (point))
		  (setq similar
			(buffer-substring beg end))
		  (switch-to-buffer "-VARIABLE-")
		  (goto-char 1)
		  (if (not (re-search-forward
			    (concat similar [ ]) nil t))
		      (progn
			(goto-char (point-max))
			(insert (concat similar "\n"))))
		  (setq similar " ")
		  (switch-to-buffer buffer))
	      (progn
		(setq pointer (+ pointer 1))
		(goto-char 1)))))))))

					; RF03.01.01, RB03.01
					; 2.5.8 declare-variable
(defun cobol-declare-variable ()
  (interactive)
"Declare the string at the cursorposition as variable by
\\[cobol-declare-variable]."
  (let
    (variable cursor
     beg end (buffer (buffer-name)))
    (if (not (or (looking-at " ")
		 (looking-at "\n")))
	(progn
	  (forward-sexp 1)
	  (setq end (point))
	  (backward-sexp 1)
	  (setq beg (point))
	  (setq variable (buffer-substring beg end))
	  (switch-to-buffer-other-window buffer)
	  (goto-char 1)
	  (if (or(search-forward cobol-file-section nil t)
		 (search-forward cobol-working-storage-section nil t))
	      (progn
		(setq cursor (point))
		(if (search-forward cobol-procedure-division nil t)
		    (setq stop (point))
		  (setq stop (point-max)))
		(goto-char cursor)
		(next-line 1)
		(beginning-of-line)
		(if (not (re-search-forward
			  (concat "\\([^*][0-9][0-9][^a-z]+"
				  variable "[^a-z]\\)") stop t))
		    (progn
		      (setq declare
			    (read-from-minibuffer "Declare your variable, ENTER for done: "
						  (concat "77  "variable" PIC ")))
		      (beep)
		      (message "Go to variable's line, insert with M-C-a C-v!"))
   		  (progn
		    (cobol-message "Variable already exists!" nil)
		    (other-window 1))))
	    (cobol-message "WORKING-STORAGE SECTION not found!" nil)))
      (cobol-message "I see no variable to declare!" nil))))

					; RF03.01.01, RB03.01.01
					; 2.5.9 add-variable
(defun cobol-add-variable ()
(interactive)
"Insert a declared variable in the current line by
\\[cobol-add-variable]."
(let (end-line (cursor (point)))
(if (search-forward cobol-procedure-division nil t)
    (progn
      (goto-char cursor)
      (end-of-line)
      (setq end-line (point))
      (beginning-of-line)
    (if (re-search-forward "[^ \\|\n]" end-line t)
	(cobol-message "Insert declaration in empty lines only!" nil)
      (if (not (string= " " declare))
	  (progn
	    (move-to-column 7 t)
	    (insert (concat declare "\n"))
	    (setq declare " "))
	(cobol-message "There is no variable to insert!" nil))))
  (cobol-message "You are not within WORKING-STORAGE SECTION" nil))))

					; RF03.01.02, RB03.01.02
					; 2.5.10 complete-variable
(defun cobol-complete-variable ()
  (interactive)
"Use the completition-mode to insert a variable at point by
\\[cobol-complete-variable]."
  (let
      (beg end
	   var end-line
	   insert-var
	   (step 1)
	   (cursor-pos (point))
	   (list-var-help '())
	   (list-var '()))
    (cobol-search-procedure)
    (if (not (= cobol-buffer-limit 0))
	(progn
	  (if (not (or (looking-at " ")
		       (looking-at "\n")))
	      (cobol-message "You are standing on a word!" nil)
	    (if (or(search-backward cobol-file-section nil t)
		   (search-backward cobol-working-storage-section nil t))
		(progn
		  (message "Searching...")
		  (while (< (point) cobol-buffer-limit)
		    (next-line 1)
		    (beginning-of-line)
		    (end-of-line)
		    (setq end-line (point))
		    (beginning-of-line)
		    (if (re-search-forward "\\([0-9][0-9]\\)" end-line t)
			(progn
			  (forward-sexp 1)
			  (backward-char 1)
			  (if (not (looking-at "\\."))
			      (forward-char 1))
			  (setq end (point))
			  (backward-sexp 1)
			  (setq beg (point))
			  (setq var (buffer-substring beg end))
			  (setq list-var-help '())
			  (setq list-var-help
				(cons step list-var-help))
			  (setq list-var-help
				(cons var list-var-help))
			  (setq list-var
				(cons list-var-help list-var))
			  (setq step (+ step 1)))))
		  (goto-char cursor-pos)
		  (setq list-var (reverse list-var))
		  (setq insert-var
			(completing-read "Complete variable: " list-var nil t))
		  (insert insert-var)
		  (delete-other-windows)
		  (split-window-vertically)
		  (other-window 1)
		  (if(not(search-backward cobol-file-section nil t))
		      (search-backward cobol-working-storage-section))
		  (if (search-forward insert-var nil t)
		      (progn
			(recenter)
			(other-window 1))
		    (progn
		      (other-window 1)
		      (delete-other-windows))))
	      (cobol-message "WORKING-STORAGE SECTION not found" nil)))))))

					; RF08, RB08
					; 2.5.11 call

(defun cobol-call ()
  (interactive)
"Insert the CALL-statement with parameters defined by the user by
\\[cobol-call]. The function generates the subprogramm."
  (let
      (sub-prog (call-pos (point)) cobol-string
		par-pos par-found-pos end-line)
    (cobol-search-procedure)
    (if (not (= cobol-buffer-limit 0))
	(progn
	  (end-of-line)
	  (setq end-line (point))
	  (beginning-of-line)
	  (if (re-search-forward "[^ \\|\n]" end-line t)
	      (cobol-message "Insert 'call' in empty lines only!" nil)
	    (progn
	      (delete-other-windows)
	      (setq buffer (buffer-name))
	      (setq sub-prog " ")
	      (cobol-minibuffer-input
	       "Name of subprogram, ENTER for done:" "subprogram")
	      (setq sub-prog cobol-string)
	      (if (or (get-buffer
		       (concat sub-prog ".cbl"))
		      (file-exists-p (concat sub-prog ".cbl")))
		  (progn
		    (cobol-message "Subprogram %s already exists!"
				   (concat sub-prog ".cbl"))
		    (goto-char call-pos))
		(progn
		  (generate-new-buffer (concat sub-prog ".cbl"))
		  (switch-to-buffer (concat sub-prog ".cbl"))
		  (goto-char 1)
					; RF01.02, RB01
		  (insert cobol-SubprgFrame)
		  (cobol-mode)
		  (goto-char 1)
					; RF01.02.01, RB01
		  (search-forward cobol-program-id)
		  (insert
		   (concat "\n           " sub-prog "."))
		  (search-forward cobol-string-author)
		  (insert (concat "\n           " cobol-author "."))
		  (search-forward cobol-string-date-written)
		  (insert (concat "\n           " cobol-date-written "."))

		  (search-forward "~")            ; --azou 3/99  (machine)
		  (delete-char -1)
		  (insert cobol-mode-system-type)
		  (search-forward "~")
		  (delete-char -1)
		  (insert cobol-mode-system-type)

		  (if (search-forward cobol-procedure-division nil t)
		      (progn
			(end-of-line)
			(newline 2)
					; RF01.02.02, RB01
			(insert (concat "       S1-"sub-prog) " SECTION.\n")
			(insert "       ANFANG-S1. \n\n           .\n")
			(insert "       ENDE-S1. \n")
			(insert "           EXIT PROGRAM.")))
		  (switch-to-buffer buffer)
		  (goto-char call-pos)
		  (cobol-indent 4 call-pos)
		  (move-to-column (+ cobol-column 1) t)
		  (insert
		   (concat "CALL " "\""sub-prog"\""))
		  (setq par-pos (point))
		  (goto-char 1)
		  (if (search-forward cobol-working-storage-section nil t)
		      (progn
			(recenter)
			(setq par-found-pos (point))
			(cobol-read-parameter))
		    (cobol-message "WORKING-STORAGE SECTION not found!" nil))))))))))

					; RF01.02.03, RF01.02.04, RB01
					; RF08, RB08
					; 2.5.12 read-parameter
(defun cobol-read-parameter ()
  (let
      (parameter beg cobol-string
       end par-decl end-line
       par-using (list-par-counter 0)
       (elem 0)
       (list-par '()))
    (cobol-minibuffer-input
     "Type one paramter & ENTER or 0 to finish:" "parameter")
    (setq parameter cobol-string)
    (if (not (string-equal "0" parameter))
	(progn
	  (goto-char 1)
	  (if (re-search-forward
	     (concat "\\([^*][0\\|7][1\\|7][^a-z]+" parameter "[^a-z]\\)")
	       cobol-buffer-limit t)
	      (progn
		(setq par-found-pos (point))
		(beginning-of-line)
		(forward-sexp 1)
		(backward-sexp 1)
		(setq beg (point))
		(end-of-line)
		(setq end (point))
		(setq par-decl (buffer-substring beg end))
		(setq list-par
		      (cons par-decl list-par))
		(goto-char call-pos)
		(end-of-line)
		(if (= (point) par-pos)
		  (progn
		    (insert " USING ")
		    (insert parameter))
		  (insert (concat ", " parameter)))
		(goto-char par-found-pos)
		(while (< (point) cobol-buffer-limit)
		  (next-line 1)
		  (end-of-line)
		  (setq end-line (point))
		  (beginning-of-line)
		  (if (not
		       (re-search-forward "\\([^*][0\\|7][1\\|7]\\)"
					  end-line t))
		     (progn
		       (beginning-of-line)
		       (if (re-search-forward "\\([0-9][0-9]\\)"
					      end-line t)
			   (progn
			     (beginning-of-line)
			     (setq beg (point))
			     (end-of-line)
			     (setq end (point))
			     (setq par-decl
				   (buffer-substring beg end))
			     (setq list-par
				   (cons par-decl list-par))
			     (setq list-par-counter
				   (+ list-par-counter 1)))))
		    (progn
		      (goto-char cobol-buffer-limit))))
		(switch-to-buffer (concat sub-prog ".cbl"))
		(goto-char 1)
		(if (search-forward cobol-procedure-division nil t)
		    (progn
		      (next-line -2)
		      (beginning-of-line)
		      (setq list-par (reverse list-par))
		      (move-to-column 7 t)
		      (while (not (> elem list-par-counter))
			(insert (nth elem list-par))
			(newline)
			(setq elem (+ elem 1)))))
		(if (search-forward cobol-procedure-division)
		    (progn
		      (setq par-using (point))
		      (end-of-line)
		      (backward-char 1)
		      (if (= (point) par-using)
			  (progn
			    (insert " USING ")
			    (insert parameter))
			(progn
			  (insert (concat ", " parameter))))
		      (switch-to-buffer buffer))))
	    (progn
	      (cobol-message "Parameter %s not found or wrong declaration! ...one moment"
			     parameter)))
	  (goto-char par-found-pos)
	  (cobol-read-parameter))
      (progn
	(switch-to-buffer (concat sub-prog ".cbl"))
	(goto-char 1)
	(if (search-forward cobol-linkage-section nil t)
	    (replace-regexp " W-\\| K-" " L-"))
	(next-line 1)
	(move-to-column 7 t)
	(write-file (concat sub-prog ".cbl"))
	(switch-to-buffer buffer)
	(goto-char call-pos)
	(cobol-message "Subprogram add in buffer %s and saved on disk!"
		 (concat sub-prog ".cbl"))))))

					; RF10, RB10
					; 2.4.1 show-version
(defun cobol-show-versions ()
  (interactive)
"Show the contents of the current RCS-file by
\\[cobol-show-version]. To select and watch at a version typ the number of the
version, or 0 to quit."
  (if (not (get-buffer "-VERSIONS-"))
      (progn
	(generate-new-buffer "-VERSIONS-")
	(setq buffer (buffer-name))
	(call-process "rlog" nil "-VERSIONS-" nil
		      (concat buffer ",v"))
	(switch-to-buffer "-VERSIONS-")
	(setq buffer-read-only nil)
	(widen)
	(goto-char 1)
	(setq start (point))
	(if (search-forward "\nrevision" nil t)
	    (progn
	      (cobol-layout-version)
	      (setq buffer-read-only t))
	  (cobol-message "no rcs-file found!" nil))
	(goto-char 1))
    (switch-to-buffer "-VERSIONS-"))
  (cobol-read-versions))

					; RF10, RB10
					; 2.4.3 read-version
(defun cobol-read-versions ()
  (let (cobol-string)
    (cobol-minibuffer-input
     "To select a version, type number or 0 to finish:" "version")
    (setq versnumber cobol-string)
    (if (string="0" versnumber)
	(progn
	  (switch-to-buffer buffer)
	  (kill-buffer "-VERSIONS-"))
      (progn
	(generate-new-buffer "error-checkout")
	(rename-file (concat default-directory buffer)
		     (concat default-directory buffer ",w"))
	(call-process "co" nil "error-checkout" nil
		      (concat "-q" versnumber) buffer)
	(switch-to-buffer "error-checkout")
	(goto-char 1)
	(if (search-forward "co error" nil t)
	    (progn
	      (switch-to-buffer "-VERSIONS-")
	      (kill-buffer "error-checkout")
	      (rename-file (concat default-directory buffer ",w")
			   (concat default-directory buffer))
	      (cobol-read-versions))
	  (progn
	    (rename-file
	     (concat default-directory buffer)
	     (concat default-directory buffer versnumber))
	    (find-file (concat buffer versnumber))
	    (delete-file (concat buffer versnumber))
	    (rename-file (concat default-directory buffer ",w")
			 (concat default-directory buffer))
	    (widen)
	    (switch-to-buffer (concat buffer versnumber))
	    (goto-char 1)
	    (kill-buffer "error-checkout")))))))

					; RF10, RB10
					; 2.4.4 layout-version
(defun cobol-layout-version ()
  (delete-region start (+ 1 (point)))
  (skip-chars-forward ".0-9")
  (setq start (point))
  (search-forward "date:")
  (delete-region start (point))
  (forward-char 20)
  (setq start (point))
  (search-forward "author:")
  (delete-region start (point))
  (search-forward ";")
  (setq start (point))
  (forward-char -1)
  (insert "\n")
  (if (search-forward "\nrevision" nil t)
      (cobol-layout-version)
    (delete-region start (point-max))))

					; RF10, RB10
					; 2.4.2 exit-checkin
(defun cobol-exit-checkin ()
  (interactive)
"Run the program CI and kill-emacs by
\\[cobol-exit-checkin]."
  (save-buffer)
  (setq buffer (buffer-name))
  (call-process "ci" nil nil nil "-q" buffer)
  (call-process "rcs" nil nil nil "-U" buffer)
  (kill-buffer buffer)
  (save-buffers-kill-emacs))

					; RF09, RB09
					; 2.1.1 compiler-call
(defun cobol-compiler-call ()
  (interactive)
"Run the compiler by \\[cobol-compiler-call]."
  (let ((cursor (point)))
    (setq cob-param cobol-mode-prog-switches) ;; --azou 4/96
    (goto-char 1)
    (while (<(point) (point-max))
      (if (search-forward " EXIT PROGRAM" nil t)
	  (progn
	    (back-to-indentation)
	    (if (looking-at "*")
		(next-line 1)
	      (progn
		(goto-char (point-max))
		(setq cob-param cobol-mode-lib-switches)))) ;; --azou 4/96
	(goto-char (point-max))))
    (goto-char cursor)
  (cobol-compile cob-param)))

					; RF09, RB09
					; 2.1.2 compile
(defun cobol-compile (cob-param)
  (let
      (buffer-length pos buffer-lst beg
		     (cursor (point))
		     call-param
		     (elem 0)
		     (error-flag nil)
		     (buffer (buffer-name))
		     (call-list
		      (cons (buffer-name)'())))
    (setq buffer-length (length buffer))
    (setq buffer-lst
	  (concat
	   (substring buffer 0 (- buffer-length 3))"lst"))
    (if (get-buffer buffer-lst)
	(kill-buffer buffer-lst))
    (save-buffer)
	(cobol-call-search)
    (setq call-list (reverse call-list))
    (if (string= error-flag "nil")
	(progn
	  (goto-char cursor)
	  (generate-new-buffer "*call-list*")
	  (set-buffer "*call-list*")
	  (while (not(> elem (length call-list)))
	    (insert (concat " "(nth elem call-list)))
	    (setq elem (+ elem 1)))
	  (goto-char (point-min))
	  (setq beg (point))
	  (goto-char (point-max))
	  (setq call-param (buffer-substring beg (point)))
	  (set-buffer buffer)
	  (kill-buffer "*call-list*")
					; RF09.01, RB09.01
	  (if (string-equal cobol-mode-compile-host "")
	      (compile
	       (concat "time " cobol-mode-compiler-name " "
		       ;; cob-param " -C reseq" call-param))
		       cob-param " " call-param)) ;;--theBlackDragon 19/07/05
	    ;;else
	    (compile
	     (concat "time rsh " cobol-mode-compile-host " cd " default-directory "; "
		     cobol-mode-compiler-name " "
		     ;; cob-param " -C reseq" call-param)))) ;;--azou 4/96, 11/96
		     cob-param " " call-param)))) ;;--theBlackDragon 19/07/05

      (goto-char pos))))

					; RF09, RB09
					; 2.1.3 call-search
(defun cobol-call-search ()
  (save-excursion
    (let (end subprg
	      (buffer (buffer-name)))
      (goto-char 1)
      (while (<(point)(point-max))
	(if (search-forward "CALL" nil t)
	    (progn
	      (setq pos (point))
	      (back-to-indentation)
	      (if (not (looking-at "*"))
		  (progn
		    (goto-char pos)
		    (forward-sexp 1)
		    (backward-char 1)
		    (setq end (point))
		    (backward-sexp 1)
		    (setq subprg (buffer-substring (point) end))
		    (setq subprg-o
			  (concat subprg ".o"))
		    (if (file-exists-p subprg-o)
			(if (not (member
				  (concat subprg ".o") call-list))
			    (progn
			      (setq call-list
				    (cons
				     (concat subprg ".o")
				     call-list))
			      (if (not (get-buffer
					(concat subprg ".cbl")))
				  (find-file (concat subprg ".cbl")))
			      (set-buffer (concat subprg ".cbl"))
			      (cobol-call-search)
			      (set-buffer buffer)))
		      (progn
			(cobol-message "Subprogram %s not compiled or not errorfree!" subprg)
			(goto-char (point-max))
			(setq error-flag "t"))))))
	  (goto-char (point-max)))))))

					; RF09.02, RB09.02
					; 2.1.4 find-errors
(defun cobol-find-errors ()
  (interactive)
"Search for errors by \\[cobol-find-errors]."
  (let
    ((buffer (buffer-name))
     run-prg buffer-lst buffer-length)
  (setq buffer-length (length buffer))
  (setq buffer-lst
	(concat
	 (substring buffer 0 (- buffer-length 3))"lst"))
  (if (file-exists-p buffer-lst)
      (progn
	(delete-other-windows)
	(if (get-buffer "*compilation*")
	    (progn
	      (set-buffer "*compilation*")
	      (goto-char 1)
	      (cond
	       ((search-forward "Compilation finished" nil t)
		(if (not (string-equal "-xcvP" cob-param))
		(progn
		  (setq run-prg
			(substring buffer 0 (- buffer-length 4)))
		  (setq suspend-hook nil)
		  (add-hook 'suspend-hook
			    (function (lambda ()
					(or
					 (y-or-n-p "Suspending Emacs to run your program ? (return with fg) ")
					 (error "Program-call cancelled")))))
		  (suspend-emacs)
		  ;Version 18
		  ;(suspend-emacs run-prg)
		  (message " ")
		  (setq suspend-hook nil)
		  (cobol-suspend-parameter))
	       (cobol-message "Compiling of subprogram finished errorfree!" nil)))
	       ((search-forward
		 "Compilation exited abnormally" nil t)
		(progn
		  (if (not (get-buffer buffer-lst))
		      (progn
			(find-file-read-only buffer-lst)
			(switch-to-buffer-other-window buffer-lst)
			(cobol-parsing-errors))
		    (switch-to-buffer-other-window buffer-lst))
		  (switch-to-buffer-other-window buffer)
		  (goto-char 1)))
	       (t (progn
		    (cobol-message "Compiling in progress!" nil)
		    (delete-other-windows)
		    (switch-to-buffer buffer)
		    (switch-to-buffer-other-window "*compilation*")
		    (other-window 1)))))
	  (cobol-message "Found old version of %s, compile again!!" buffer-lst)))
    (cobol-message "You can't find errors without compiling, compile first!" nil))))

					; RF09.02, RF09.03
					; RB09.02, RB09.03
					; 2.1.5 parsing-errors
(defun cobol-parsing-errors ()
  (let
      ((lst 0) (line 4) end beg last (region 0))
    (setq cobol-list-lst
	  (cons 0'()))
    (setq cobol-list-cbl
	  (cons 0'()))
    (goto-char 1)
    (setq end
	  (count-lines (point-min)(point-max)))
    (next-line 3)
    (while (not (>= line end))
      (message
       (concat "Parsing Error-List.....Line: " line " of " end))
      (if (re-search-forward "^\\*\\*" nil t)
	  (progn
	    (re-search-backward "^ ")
	    (forward-word 1)
	    (setq last (point))
	    (backward-word 1)
	    (setq beg (point))
	    (setq region
		  (string-to-number
		   (buffer-substring beg last)))
	    (setq cobol-list-cbl
		  (cons region cobol-list-cbl))
	    (setq lst
		  (count-lines (point-min) (point)))
	    (setq cobol-list-lst
		  (cons lst cobol-list-lst))
	    (if (not (re-search-forward "^ "nil t))
		(progn
		  (message "End of parsing!")
		  (goto-line end))))
	(progn
	  (goto-line end)
	  (message "End of parsing!")))
      (setq line
	    (count-lines (point-min) (point)))
      (setq line (+ line 1)))
    (setq cobol-list-lst
	  (reverse cobol-list-lst))
    (setq cobol-list-cbl
	  (reverse cobol-list-cbl))
    (setq cobol-pointer 0)))

					; RF09.04, RB09.04
					; 2.1.6 next-error
(defun cobol-next-error ()
  (interactive)
"Show the next error in the listing of the compiler and in the
 Sourcecode by \\[cobol-next-error]."
  (let
      (listlength lst-elem
		  cbl-elem buffer-lst buffer-length
		  (buffer (buffer-name)))
    (setq buffer-length (length buffer))
    (setq buffer-lst
	  (concat
	   (substring buffer 0 (- buffer-length 3))"lst"))
    (if (get-buffer buffer-lst)
	(progn
	  (goto-char 1)
	  (switch-to-buffer-other-window buffer-lst)
	  (goto-char 1)
	  (setq listlength (length cobol-list-lst))
	  (setq cobol-pointer (+ cobol-pointer 1))
	  (if (= cobol-pointer listlength )
	      (setq cobol-pointer 1))
	  (setq lst-elem
		(nth cobol-pointer cobol-list-lst))
	  (setq cbl-elem
		(nth cobol-pointer cobol-list-cbl))
	  (goto-line lst-elem)
	  (recenter)
	  (switch-to-buffer-other-window buffer)
	  (goto-line cbl-elem)
	  (recenter))
      (progn
	(cobol-message "You can't watching at errors without parsing, parse first!" nil)))))

					; RF09.04, RB09.04
					; 2.1.7 previous-error
(defun cobol-previous-error ()
  (interactive)
"Show the previous error in the listing of the compiler and in the
 Sourcecode by \\[cobol-previous-error]."
  (let
      (listlength lst-elem
		  cbl-elem buffer-lst buffer-length
		  (buffer (buffer-name)))
    (setq buffer-length (length buffer))
    (setq buffer-lst
	  (concat
	   (substring buffer 0 (- buffer-length 3))"lst"))
    (if (get-buffer buffer-lst)
	(progn
	  (goto-char 1)
	  (switch-to-buffer-other-window buffer-lst)
	  (goto-char 1)
	  (setq cobol-pointer (- cobol-pointer 1))
	  (if (< cobol-pointer 1 )
	      (progn
		(setq listlength (length cobol-list-lst))
		(setq cobol-pointer listlength)
		(setq cobol-pointer (- cobol-pointer 1))))
	  (setq lst-elem
		(nth cobol-pointer cobol-list-lst))
	  (setq cbl-elem
		(nth cobol-pointer cobol-list-cbl))
	  (goto-line lst-elem)
	  (recenter)
	  (switch-to-buffer-other-window buffer)
	  (goto-line cbl-elem)
	  (recenter))
      (progn
	(cobol-message "You can't watching at errors without parsing, parse first!" nil)))))

(defun cobol-suspend-parameter ()
(add-hook 'suspend-hook
	  (function (lambda ()
		      (or (y-or-n-p
			   "Really suspend ?")
			  (error "Suspend cancelled"))))))

					; RF07, RB07
					; 2.2.3 corresponding
(defun cobol-corresponding (beg-const end-const)
  (let
      (stop end-line)
    (goto-char cursor)
    (if (search-backward cobol-section nil t)
	(setq stop (point))
      (setq stop (point-min)))
    (goto-char cursor)
    (while (> (point) stop)
      (if (not (= count-word count-word-end))
	  (progn
	    (next-line -1)
	    (end-of-line)
	    (setq end-line (point))
	    (back-to-indentation)
	    (if (not (looking-at "*"))
		(progn
		  (beginning-of-line)
		  (if (re-search-forward end-const end-line t)
		      (setq count-word-end
			    (+ count-word-end 1)))
		  (if (re-search-forward beg-const end-line t)
		      (setq count-word-end
			    (- count-word-end 1))))))
	(progn
	  (setq found (point))
	  (setq stop (point)))))))

					; Rf07, 2.2.4 corresponding-construct
(defun cobol-corresponding-construct ()
(interactive)
"Show the corresponding beginning of a construct
 by \\[cobol-corresponding-construct]."
   (let
       (found (count-word 0)
	(count-word-end 1)
	beg-const end-const end
	(cursor (point)))
     (cobol-search-procedure)
     (if (not (= cobol-buffer-limit 0))
	 (if (not (or (looking-at " ")
		      (looking-at "\n")))
	     (progn
	       (forward-sexp 1)
	       (setq end (point))
	       (backward-sexp 1)
	       (setq end-const (buffer-substring (point) end))
	       (if (> (length end-const) 4)
		   (progn
		     (setq end-const (substring
				      (buffer-substring (point) end) 0 4))
		     (if (or (string-equal "end-" end-const)
			     (string-equal "END-" end-const))
			 (progn
			   (setq beg-const
				 (concat " " (substring
					      (buffer-substring end (point)) 4)))
			   (setq end-const
				 (substring (buffer-substring (point) end) 0))
			   (if (or
				(string-equal " perform" beg-const)
				(string-equal " PERFORM" beg-const))
			       (setq beg-const cobol-perform-until))
			   (cobol-corresponding beg-const
						end-const)
			   (if (= count-word count-word-end)
			       (progn
				 (goto-char found)
				 (sit-for 4)
				 (goto-char cursor))
			     (progn
			       (goto-char cursor)
			       (cobol-message "I miss %s!" beg-const))))
		     (progn
		       (cobol-message "You are not standing on an \"END-...\" construct!" nil)
		       (goto-char cursor))))
		 (progn
		   (cobol-message "You are not standing on an \"END-...\" construct!" nil)
		   (goto-char cursor))))
	   (progn
	     (cobol-message "You are not standing on an \"END-...\" construct!" nil)
	     (goto-char cursor))))))

					; RF03.02.03, RB03.02.03
					; 2.2.5 consistence-variable
(defun cobol-consistence-variable ()
  (interactive)
"Check the consistence of declared and used variables
 by \\[cobol-consistence-variable]."
  (let
      (beg end start
	   var end-line
	   (elem 0)
	   (buffer (buffer-name))
	   (list-var-counter 0)
	   read-end-variable
	   insert-var
	   (cursor-pos (point))
	   (list-var '()))
    (goto-char 1)
    (if (search-forward cobol-procedure-division nil t)
	(setq read-end-variable (point))
      (setq read-end-variable (point-max)))
    (goto-char 1)
      (if (or(search-forward cobol-file-section nil t)
	     (search-forward cobol-working-storage-section nil t))
	  (progn
	    (message "Checking consistence...")
	    (while (< (point) read-end-variable)
	      (next-line 1)
	      (beginning-of-line)
	      (end-of-line)
	      (setq end-line (point))
	      (beginning-of-line)
	      (if (re-search-forward "\\([0-9][0-9]\\)" end-line t)
		  (progn
		    (forward-sexp 1)
		    (backward-char 1)
		    (if (not (looking-at "\\."))
			(forward-char 1))
		    (setq end (point))
		    (backward-sexp 1)
		    (setq beg (point))
		    (setq var (buffer-substring beg end))
		    (setq list-var-counter (+ list-var-counter 1))
		    (setq list-var
			  (cons var list-var)))))
	    (setq list-var (reverse list-var))
	    (if (get-buffer "*consistence*")
		(kill-buffer "*consistence*"))
	    (generate-new-buffer "*consistence*")
	    (if (search-backward cobol-procedure-division nil t)
		(progn
		  (setq start (point))
		  (while (< elem list-var-counter)
		    (if (not (search-forward (nth elem list-var) nil t))
			(progn
			  (switch-to-buffer "*consistence*")
			  (insert (concat
				   (nth elem list-var) "\n"))))
		    (switch-to-buffer buffer)
		    (goto-char start)
		    (setq elem (+ elem 1)))
		  (goto-char cursor-pos)
		  (switch-to-buffer "*consistence*")
		  (if (not (= (point-min) (point-max)))
		      (progn
			(switch-to-buffer buffer)
			(switch-to-buffer-other-window "*consistence*")
			(other-window 1)
			(cobol-message "Variables never used in PROCEDURE DIVISION!" nil))
		    (progn
		      (switch-to-buffer buffer)
		      (kill-buffer "*consistence*")
		      (delete-other-windows)
		      (cobol-message "All declared variables are used!" nil))))))
	(cobol-message "WORKING-STORAGE SECTION not found" nil))))

					; Help-function to read from
					; minibuffer

(defun cobol-minibuffer-input (cobol-minibuffer-message input)
  (let ()
  (setq cobol-string
	(read-from-minibuffer cobol-minibuffer-message))
  (if (string-equal "" cobol-string)
      (progn
	(cobol-message "Enter %s!" input)
	(cobol-minibuffer-input cobol-minibuffer-message input))
    (if (string-equal (substring cobol-string 0 1) " ")
	(progn
	  (cobol-message "Don't type space as first char!"  nil)
	  (cobol-minibuffer-input cobol-minibuffer-message input))))))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; Azou.

(defun cobol-mode-save-boni ()
"Foo."
;;; speaking of pointless exercises. This is just so we never end up
;;; with an empty save-hook while testing.
  (goto-char 1))


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

(defun cobol-uppercase-source ()
"*Change the source code to uppercase letters like in COBOL-74 files.
Several other routines depends on the code being in uppercase,
for instance the keyword-highlighting (font-lock), the Nassi-generator,
the folding (level-parser/outline-mode) and the HTML-generator."

  (interactive)

  (setq upbuf (concat (buffer-name) ".up"))
  (setq src (buffer-name))

  (if (get-buffer upbuf)
      (kill-buffer upbuf))
  (generate-new-buffer upbuf)

  (setq lc 0)

  (goto-char 1)
  (while (< (point) (point-max))
    (beginning-of-line)
    (setq bol (point))
    (end-of-line)
    (setq eol (point))
    (setq line (buffer-substring bol (min eol (+ bol 7))))
    (move-to-column 6)
    (if (string-equal (buffer-substring (point) (+ (point) 1)) "*")
	  (setq line (buffer-substring (min (point-max) bol) (min (point-max) eol)))
      ;;else
      (move-to-column 7)
      (setq len (- eol bol))
      (while (and (< (point) eol) (< (length line) len))
	(setq foo (point))
	(if (and (search-forward "\"" nil t) (< (point) eol))
	    (progn                                              ; upcase
	      (setq line (concat line (upcase (buffer-substring foo (point)))))
	      (setq foo (point))
	      (if (not (and (search-forward "\"" nil t) (< (point) eol)))
		  (goto-char eol))
	      (setq line (concat line (buffer-substring foo (point)))))
          ;;else                                            ; copy rest
	  (setq line (concat line (upcase (buffer-substring foo eol)))))))
    (setq lc (+ lc 1))
    (message (concat "Changing line " lc "..."))
    (set-buffer upbuf)
    (insert (concat line "\n"))
    (set-buffer src)
    (goto-char (+ eol 1)))
  (set-buffer src)
  (delete-region (point-min) (point-max))
  (insert-buffer upbuf)
; (kill-buffer upbuf)
  (message nil))

(defun cobol-remove-xs-spaces ()
"*Remove excess spaces at the end of a buffer's lines."

  (interactive)

  (setq lc 0)

  (goto-char 1)
  (while (< (point) (point-max))
    (beginning-of-line)
    (setq bol (point))
    (end-of-line)
    (setq eol (point))

    ;; remove CRs at EOL
    (while (string-equal (buffer-substring (- (point) 1) (point)) "\^M")
      (delete-region (- (point) 1) (point))
      (goto-char (- (point) 1))
      (setq eol (point)))

    (if (search-backward-regexp "[^ \t]" nil t)
	(progn
	  (if (>= (point) bol)                       ; any characters at all?
	      (progn                                 ; ->yes!
		(if (< (point) eol)                  ; any trailing spaces?
		    (progn                           ; -> yes
		      (delete-region (+ (point) 1) eol))
		  ;;else                             ; no spaces at end
		  ;; (goto-char eol)
		  ))
	    ;;else                                   ; nothing but spaces
	    (delete-region bol eol)
	    (goto-char (+ bol 1))))
      ;;else
      (goto-char eol))

    (beginning-of-line)
    (setq lc (+ lc 1))
    (message (concat "Changing line " lc "...")))

  (message nil))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;; NASSIFIER

;;; menu-handlers

(defun cobol-nassi-cmd-toggle ()
  (interactive)
  (if (= cobol-nassi-include-commands 1)
      (setq cobol-nassi-include-commands 0)
    (setq cobol-nassi-include-commands 1))
  (set-menubar-dirty-flag))


(defun cobol-nassi-warning-toggle ()
  (interactive)
  (if (= cobol-nassi-include-warnings 1)
      (setq cobol-nassi-include-warnings 0)
    (setq cobol-nassi-include-warnings 1))
  (set-menubar-dirty-flag))

(defun cobol-nassi-debug-toggle ()
  (interactive)
  (if (= cobol-nassi-include-debug 1)
      (setq cobol-nassi-include-debug 0)
    (setq cobol-nassi-include-debug 1))
  (set-menubar-dirty-flag))

;;; add output lines

(defun cobol-add-nassi (bufname line)
  (if (> (length line) 0)
      (progn
	(setq cobol-nassi-latex-line-counter (+ cobol-nassi-latex-line-counter 1))
	(setq cob-buf (buffer-name))
	(set-buffer bufname)
	(if (string-equal line "}")
	    (setq cobol-nassi-indent (- cobol-nassi-indent 1)))
	(setq ind cobol-nassi-indent)
	(while (> ind 0)
	  (insert "  ")
	  (setq ind (- ind 1)))
	(insert (concat line "%\n"))
	(set-buffer cob-buf)
	(if (or (string-equal line "{")
		(string-equal line "\\THEN{")
		(string-equal line "\\ELSE{"))
	    (setq cobol-nassi-indent (+ cobol-nassi-indent 1))))))

(defun cobol-add-nassi-debug (bufname line)
  (setq cobol-nassi-debug-line-counter (+ cobol-nassi-debug-line-counter 1))
  (if (= cobol-nassi-include-debug 1)
      (cobol-add-nassi bufname (concat "%% debug: " line))))

(defun cobol-add-nassi-error (bufname line)
  (setq cobol-nassi-errors (+ cobol-nassi-errors 1))
  (cobol-add-nassi bufname (concat "%% ERROR: " line)))

(defun cobol-add-nassi-warning (bufname line)
  (setq cobol-nassi-warnings (+ cobol-nassi-warnings 1))
  (if (= cobol-nassi-include-warnings 1)
      (cobol-add-nassi bufname (concat "%% WARNING: " line))))

(defun cobol-add-perform (bufname cc)
  (cobol-add-nassi nassi (concat "\\WHILE{" cc "}"))
  (cobol-add-nassi nassi "{"))


;;; analysis

(defun cobol-chk-nest (nassi beg end cct f2 to)
 "Analyse a COBOL-struct (IF/PERFORM/EVAL etc.)."

 ;; we will work with the example of "PERFORM"
 ;; nassi name of our nassi-struct buffer
 ;; beg   "PERFORM"
 ;; end   "END-PERFORM"
 ;; cct   "UNTIL"
 ;; last  cc comes after "UNTIL" (t) - nil would mean it comes before ("THEN")
 ;; f2    f2-pointer fm calling procedure (points to space after "PERFORM")
 ;; to    to-pointer fm calling procedure (points to... er...)

  ;; find dot
  (goto-char f2)
  (setq dot (point-max))
  (if (search-forward "." nil t)
      (setq dot (point)))
  (goto-char f2)

  ;; find end-statement (END-PERFORM)
  (if (search-forward end nil t)
      (setq endp (point))
    (setq endp (point-max)))
  (goto-char f2)

  ;; find condition-tag (THEN/UNTIL/TIMES/WHEN)
  (if (search-forward cct nil t)
      (setq cctp (point))
    (setq cctp (point-max)))
  (goto-char f2)

  ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; check dot (is it a quoted one?)

  (setq dotp 0)
  (while (= dotp 0)
    (if (search-forward "." nil t)    ; dot found?
	(progn                        ; check context, might be quoted
	  (setq dotp (point))
	  (setq dot2p dotp)
	  (move-to-column 7)
	  (if (string-equal (buffer-substring fm (point)) "*")
	      (setq dotp 0)
	    ;;else                    ; not *-line
	    (move-to-column 72)
	    (if (< (point) dotp)      ; columns > 72 are comments
		(setq dotp 0)
	      ;;else                  ; not a comment
	      (setq quote 0)
	      (move-to-column 7)
	      (while (< (point) dotp)
		(if (and (search-forward "\"" nil t) (< (point) dotp))
		    (progn
		      (if (= quote 0)
			  (setq quote 1)
			;;else
			(setq quote 0)))
		  ;;else
		  (goto-char dotp)))
	      (if (= quote 1)         ; unlucky, this was a quoted dot
		  (progn
;		    (cobol-add-nassi-debug nassi "quoted dot detected.")
		    (setq dotp 0)))   ; invalidate match
	      ))
;	  (cobol-add-nassi-debug nassi (concat "going to " dot2p ", dotp is " dotp))
	  (goto-char dot2p))
      ;;else
      (setq dotp (point-max))))

  (if (< dotp (point-max))
      (progn
;	(goto-char dotp)
;	(move-to-column 8)
;	(setq fm (point))
;	(search-forward-regexp "$")
;	(cobol-add-nassi-debug nassi (concat "valid dot-terminator at \""
;					   (buffer-substring fm (point)) "\""))
	)
    ;;else
;    (cobol-add-nassi-debug nassi "no more valid dot-terminators")
    )
  (goto-char f2)

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

  (setq sndp 0)
  (while (= sndp 0)
    (if (search-forward beg nil t)    ; find next occurrance of "PERFORM"
	(progn                        ; found
	  (setq sndp (point))         ; position behind match
	  (search-backward-regexp "[^---A-Z]" nil t)   ; position before word
	  (search-backward-regexp "[---A-Z]" nil t)  ; last character of previous word
	  (setq t2 (+ (point) 1))     ; set to-marker behind previous word
	  (search-backward-regexp "[^---A-Z]" nil t)   ; position before prvs word
	  (setq fm (+ (point) 1))     ; set fm-marker to beginning of prvs word
	  (if (string-equal (buffer-substring fm t2) "EXIT")
	      (progn                     ; this is "EXIT PERFORM", not "PERFORM"
		(goto-char (+ sndp 1))   ; position behind the "PERFORM" bit
		(setq sndp 0)            ; invalidate match
  (cobol-add-nassi-debug nassi "EXIT PERFORM/IF/EVAL detected")
              ))
	  )
      ;else
      (setq sndp (point-max))))       ; none found
  (goto-char f2)                      ; reset point

; (cobol-add-nassi-debug nassi (concat "dot: " dotp "\tend: " endp))

  (if (< dotp endp)                   ; this constructs ends with ".", not
      (progn                          ; end ("." i/o "END-PERFORM")
	(setq dotp (- dotp 1))
	(setq endp dotp))
    ;;else
    (setq dotp (point-max)))          ; from safety to... where? ###

  (if (< sndp endp)                   ; uh-oh, nested construct -> construct
	(setq endp sndp))             ; ends at beginning of inside-cons as
                                      ; far as we are concerned

  (if (> cctp endp)                   ; cct ("UNTIL") is _behind_ end ("." or
      (setq cctp (point-max)))        ; "END-PERFORM" (or nested "PERFORM")),
                                      ; so it's not for this construct

  ;; so let's see what we've got so far...

  ;; let's try to figure out the condition code

  (if (< cctp endp)                   ; cool, we've got a delimiter
      (progn
	(if (string-equal beg "PERFORM")
	    (progn                    ; cc comes last (after "UNTIL")
	      (if (string-equal "UNTIL" (buffer-substring f2 cctp))
		  (progn              ; PERFORM UNTIL cc things ...
		    (setq cc "")
		    (goto-char (+ cctp 1))
		    (while (or (looking-at cobol-cc-regexp) (not (looking-at cobol-cc-not)))
		      (setq cctp (point))
		      (search-forward " " nil t)
		      (setq cc (concat cc (buffer-substring cctp (point))))
		      )
		    (while (string-match "[\t\n ]" cc -1)
		      (setq cc (substring cc 0 -1)))
  (cobol-add-nassi-debug nassi "WHILE2 - '85-PERFORM \"PERFORM UNTIL BAR FOO END-PERFORM\"...")
		    (cobol-add-nassi nassi (concat "\\WHILE{NOT " cc "}"))
		    (cobol-add-nassi nassi "{")
		    (goto-char f2)    ; position behind construct
		    (if (and (search-forward-regexp "$" nil t)
			     (> (point) endp))
			(progn
			  (cobol-add-nassi nassi (concat "\\ACTION{do a lot of inlined stuff}"))
			  (cobol-add-nassi nassi (concat "}"))
			  (cobol-add-nassi nassi (concat "\\ENDWHILE"))
			  )
		      ;;else
		      (setq cobol-nassi-whiles (+ cobol-nassi-whiles 1))
		      (setq to f2)    ; azou07/10/96 - test
		      ))
		;;else                ; PERFORM foo UNTIL bar
		(goto-char endp)
		;; (search-backward " ")
		(setq cc (buffer-substring (+ cctp 1) (point)))
  (cobol-add-nassi-debug nassi "WHILE2 - '74-PERFORM \"PERFORM FOO UNTIL BAR\"...")
		(cobol-add-nassi nassi (concat "\\WHILE{NOT " cc "}"))
		(cobol-add-nassi nassi "{")
		(goto-char f2)
		(search-forward " ")
		(if (not (= f2 cctp))
		    (progn
		      (cobol-add-nassi nassi (concat "\\ACTION{call subroutine " (buffer-substring f2 (- (point) 1)) "}"))
		      (cobol-add-nassi nassi "}")
		      (cobol-add-nassi nassi "\\ENDWHILE")
		      )
		  )
		)
	      )
	  ;else                       ; cc comes first (before "THEN")
	  (goto-char cctp)
	  (search-backward " ")
	  (setq cc (buffer-substring f2 (point)))
	  (cobol-add-nassi nassi (concat "\\IF{" cc "}"))
	  (cobol-add-nassi nassi "\\THEN{")
	  )
	)




    ;else                             ; no delimiter
    (if (string-equal beg "PERFORM")  ; "PERFORM" is easy - no "UNTIL"
	(progn
;	  (if (> dotp endp)           ; we have an END-PERFORM
;	      (progn
;  (cobol-add-nassi-debug nassi "GOSUB1 - '85-PERFORM \"PERFORM FOO END-PERFORM\"...")
;  (cobol-add-nassi-debug nassi "we shud never get here - what's the point to this construct!? -> fixing")
;  ;(setq cobol-nassi-whiles (+ cobol-nassi-whiles 1))
;		(cobol-add-nassi nassi (concat "\\ACTION{do diverse things before END-PERFORM...}"))
;		)
	    ;;else                    ; no END-PERFORM
  (cobol-add-nassi-debug nassi "GOSUB2 - '74-PERFORM \"PERFORM FOO.\"...")
            (goto-char f2)
	    (if (search-forward-regexp "[\t \n.]" nil t)
	      (setq endp (- (point) 1)))
	    (cobol-add-nassi nassi (concat "\\ACTION{call subroutine " (buffer-substring f2 endp) "}"))
	    (setq to endp)            ; kludg-e-fix --azou 7/96
	    )
;	  )


      ;else                           ; "IF" - uh-oh...
      (goto-char f2)                  ; begin at the beginning
      (setq cc "")
      (while (or (looking-at cobol-cc-regexp) (not (looking-at cobol-cc-not)))
	(setq cctp (point))
	(search-forward " " nil t)
	(setq cc (concat cc (buffer-substring cctp (point))))
	)
      (cobol-add-nassi nassi (concat "\\IF{" (substring cc 0 -1) "}"))
      (cobol-add-nassi nassi "\\THEN{")
      (if (< dotp endp)        ; dot-terminated IF
	  (progn
	    (cobol-add-nassi-debug nassi "IF, allegedly .-terminated...")
	    (setq f2 (point))         ; what's in IF?
	    (search-forward " ")
	    (if (string-equal (buffer-substring f2 (- (point) 1)) "PERFORM")
		(progn                ;PERFORM inside IF
		  (cobol-add-nassi-debug nassi "IF contains PERFORM clause...")
		  (setq f2 (point))
		  (setq cc (concat "call subroutine " (buffer-substring f2 endp))))
	      ;; else (something else, and since it's the only thing in IF
	      ;; and there should be _something_ in our Nassi, we'll copy it,
	      ;; regardless of how boring or unimportant it is :-)
	      (cobol-add-nassi-debug nassi "IF contains nothing of interest, but we need *something* for the nassi")
	      (goto-char f2)
	      (setq cc (buffer-substring f2 endp))
	      )
	    (cobol-add-nassi nassi (concat "\\ACTION{" cc "}")))
	;; else
	(cobol-add-nassi-debug nassi "IF, END-IF determinated...")
	(setq beg "")))) ; nasty hack: don't add empty else-clause just yet s/b

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; kludg-E-fix (adds empty ELSE-clauses)

  (if (string-equal beg "IF")
      (progn
	(setq cobol-nassi-ifs (+ cobol-nassi-ifs 1))
	(goto-char cctp)
	(setq f2 (point-max))
	(if (search-forward "ELSE" nil t)  ; find ELSE
	    (progn                      ; found.
	      (if (< (point) endp)      ; for current IF?
		  (setq f2 (point)))))  ; yes, save position
	(if (= f2 (point-max))          ; if not found or not for current IF
	    (progn                      ; add empty ELSE-statement to make
					; the nassi-mode happy
	      (cobol-add-nassi-debug nassi "Auto-inserting empty ELSE-clause...")
	      (cobol-add-nassi nassi "}")
	      (cobol-add-nassi nassi "\\ELSE{")
	      (cobol-add-nassi nassi "\\ACTION{---}")
	      (cobol-add-nassi nassi "}")
	      (cobol-add-nassi nassi "\\ENDIF")
	      (setq cobol-nassi-ifs (- cobol-nassi-ifs 1))))))

  (goto-char to))


(defun cobol-chk-struct (nassi)
  "Checks whether all IFs have END-IFs etc."
    ;; to be on the safe side
    (while (> cobol-nassi-whiles 0)
        (setq cobol-nassi-whiles (- cobol-nassi-whiles 1))
        (cobol-add-nassi-error nassi "ENDWHILE missing, added. (missing END-PERFORM in source?)")
        (cobol-add-nassi nassi "}")
        (cobol-add-nassi nassi "\\ENDWHILE"))
    (while (> cobol-nassi-ifs 0)
        (setq cobol-nassi-ifs (- cobol-nassi-ifs 1))
        (cobol-add-nassi-error nassi "ENDIF missing, added. (missing END-IF in source?)")
        (cobol-add-nassi nassi "}")
        (cobol-add-nassi nassi "\\ENDIF"))
    (while (> cobol-nassi-evals 0)
        (setq cobol-nassi-evals (- cobol-nassi-evals 1))
        (cobol-add-nassi-error nassi "ENDCASE missing, added. (missing END-EVAL in source?)")
        (cobol-add-nassi nassi "}")
        (cobol-add-nassi nassi "\\ENDIF")))

(defun cobol-split-lines (nassi)
  "Modifies but the nastiest of sources."
  (cobol-add-nassi-warning nassi "uh-oh, ClOMO's little mind is blown: lines split!")
  (insert "\n            "))

(defun cobol-nassify-source ()
  "Generate source for LaTeX Nassi-mode from COBOL '74-source in new buffer."

 ;; this thing is not fine-tuned in any way; also, it doesn't do real
 ;; parsing; we sacrificed this for the sake of speed and convenience.
 ;; unfortunately, the function doesn't really make easy reading anymore
 ;; because of this. COBOL '74 works fine, COBOL '85 will probably break
 ;; the converter if used in unspeakable ways

  (interactive)

  (setq cobol-nassi-whiles 0)
  (setq cobol-nassi-ifs 0)
  (setq cobol-nassi-evals 0)

  (setq cobol-nassi-latex-line-counter 0)
  (setq cobol-nassi-debug-line-counter 0)
  (setq lc 0)

  (setq cobol-nassi-errors 0)
  (setq cobol-nassi-warnings 0)

  (setq nassi (buffer-name))
  (setq nassi (substring nassi 0 (string-match "\\." nassi)))
  (setq nassi (concat nassi ".tex"))

  (setq cobol-nassi-indent 2)

  (if (get-buffer nassi)
      (kill-buffer nassi))
  (generate-new-buffer nassi)

  (setq src (buffer-name))
  (set-buffer nassi)
  (insert (concat cobol-nassi-head cobol-nassi-sub-head
		  src cobol-nassi-foo "Overall structure" cobol-nassi-bar))
  (set-buffer src)

  (goto-char 1)
  (search-forward "PROCEDURE DIVISION")
  (setq cc "CONDITION")

  (while (< (point) (- (point-max) 1))
    (setq lc (+ lc 1))
    (message (concat "Generating source for LaTeX Nassi-mode (Stardate " lc "."
		     cobol-nassi-latex-line-counter "."
		     cobol-nassi-debug-line-counter ")..."))

    (move-to-column 6)
    (setq fm (point))
    (move-to-column 7)
    (if (not (string-equal (buffer-substring fm (point)) "*"))
	(progn
	  (search-forward-regexp "[A-Za-z]" nil t)
	  (setq fm (- (point) 1))

	  ;; debug info
	  (beginning-of-line)
	  (setq f2 (point))
	  (end-of-line)
	  (cobol-add-nassi-debug nassi (concat "LOOKING AT \"" (buffer-substring f2 (point)) "\""))
	  (if (= f2 (point))
	      (progn
		(cobol-add-nassi-debug nassi "fishy jump, should only occur when we reach EOT and there are empty lines")
	      (goto-char (point-max)))  ; this is pretty fishy, but can't be (goto-char (+ f2 1))
	    ;;else
	    (goto-char (+ fm 1)))

	  (search-forward-regexp "[\\. ]" nil t)
	  (setq f2 (point))
	  (setq to (- (point) 1))
	  (setq word-1 (buffer-substring fm to))
	  (setq word-2 (buffer-substring (- (point) 1) (point)))

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

	  (if (not (string-equal word-2 "."))        ; doesn't end on .
	      (progn
		(if (string-equal word-1 "EXIT")     ; EXIT
		    (progn
		      (goto-char (+ to 1))
		      (search-forward-regexp "[ \t]" nil t)
		      (if (string-equal (buffer-substring (+ to 1) (- (point) 1)) "PERFORM")
			  (progn                     ; EXIT PERFORM
			    (cobol-add-nassi-debug nassi "potential bug-fix ((goto-char) disabled)")
			    (cobol-add-nassi-warning nassi "Eek! EXIT PERFORM detected, which is bad style, and a Bad Thing because it doesn't appear in the Nassi properly...")
			    (cobol-add-nassi nassi "\\ACTION{< --- EXIT LOOP}")))
;		      (goto-char (+ to 1))
		      (cobol-add-nassi-debug nassi (concat "now looking at " (buffer-substring (point) (+ (point) 30))))
		      (cobol-split-lines nassi)      ; uh-oh! modifies nasty source here!
		      )
		  ;; else (not EXIT)
		(search-forward "." nil t)
		(setq to (- (point) 1))
		(search-backward " " nil t)
		(setq fm (+ (point) 1))
		(setq word-2 (buffer-substring fm to))
		(goto-char to)

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

		(if (string-equal word-2 "SECTION")
		    (progn
		      (cobol-chk-struct nassi)
		      (set-buffer nassi)
		      (insert cobol-nassi-sub-foot)
		      (insert (concat cobol-nassi-sub-head
				      src cobol-nassi-foo
				      word-1 cobol-nassi-bar))

		      (set-buffer src)
;		      (cobol-add-nassi nassi (concat "\\ACTION{ --- " word-1 " --- }"))
		    ))

		;; (cobol-add-nassi-debug nassi (concat "% :parsing:{" word-1 "|" word-2 "}"))

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

		(if (string-equal word-1 "END-PERFORM")
		    (progn
		      (setq cobol-nassi-whiles (- cobol-nassi-whiles 1))
		      (if (< cobol-nassi-whiles 0)
			  (progn
			    (setq cobol-nassi-whiles 0)
			    (cobol-add-nassi-error nassi "excess ENDWHILE left out. (END-PERFORM without PERFORM in source?)")
			    )
			;;else
			(cobol-add-nassi nassi "}")
			(cobol-add-nassi nassi "\\ENDWHILE"))))

		(if (string-equal word-1 "ELSE")
		    (progn
		      (cobol-add-nassi nassi "}")
		      (cobol-add-nassi nassi "\\ELSE{")))

		(if (string-equal word-1 "END-IF")
		    (progn
		      (setq cobol-nassi-ifs (- cobol-nassi-ifs 1))
		      (if (< cobol-nassi-ifs 0)
			  (progn
			    (setq cobol-nassi-ifs 0)
			    (cobol-add-nassi-error nassi "excess ENDIF left out. (END-IF without IF in source?)")
			    )
			;;else
			(cobol-add-nassi nassi "}")
			(cobol-add-nassi nassi "\\ENDIF"))))

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

		(if (string-equal word-1 "PERFORM")
		    (cobol-chk-nest nassi "PERFORM" "END-PERFORM" "UNTIL" f2 to))

		(if (string-equal word-1 "IF")
		    (cobol-chk-nest nassi "IF" "END-IF" "THEN" f2 to))

		(if (string-equal word-1 "EVAL")
		    (cobol-chk-nest nassi "EVALUATE" "END-EVALUATE" "foo" f2 to))
		)
;;;;;;;;;;;;;

	    ;;else
	    (if (string-equal word-1 "DECLARATIVES")
		(progn
		  (search-forward "END DECLARATIVES")
		  (cobol-add-nassi-debug nassi "Skipping DECLARATIVES..."))
	      ;;else
	      (cobol-add-nassi nassi (concat "\\ACTION{ -- " word-1 " -- }"))))))

      ;; copy comments from source
      (move-to-column 999)  ; 80 s/b enough, theoretically speaking
      ;; uncomment the following line if you want to copy comments from source
      (if (= cobol-nassi-include-debug 0)
        (cobol-add-nassi nassi (concat "% " (buffer-substring fm (point)))))
      )

    ;; go to next line
    (if (not (search-forward-regexp "^" nil t))
      (goto-char (point-max))))

    (cobol-chk-struct nassi)

    ;; append footer
    (set-buffer nassi)
    (insert cobol-nassi-sub-foot)
    (insert cobol-nassi-foot)
    (set-buffer src)

    (switch-to-buffer nassi)
    (tex-mode)
    (font-lock-fontify-buffer)
    (goto-char 1)
    (insert (concat "% Nassi-Schneiderman diagram for " src "\n"))
    (insert (concat "% (source for LaTeX Nassi-mode)\n%\n"))

    ;; stats
    (insert (concat "% read " lc " lines; generated "
		     cobol-nassi-latex-line-counter " lines LaTeX and "
		     cobol-nassi-debug-line-counter " lines debug/comment-info.%\n%\n"))

    ;; add error/warning information
    (if (> cobol-nassi-warnings 0)
        (insert (concat "%--> " cobol-nassi-warnings " case(s) of potential sloppiness, please check WARNINGs%\n%\n")))
    (if (> cobol-nassi-errors 0)
        (insert (concat "%==> " cobol-nassi-errors " case(s) of applied strangeness, please check ERRORs%\n%\n"))
    (if (or (> cobol-nassi-errors 0) (> cobol-nassi-warnings 0))
        (insert "% NB  The converter is known to work with straight-forward '74 code.%\n%     '85 code or dirty things will probably break it.%\n\n"))
    ))

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

(defun cobol-mark-struct (cobol-struct cobol-struct-level)
  "Add level-marker for outline minor-mode for given construct."

  (interactive)

  (goto-char 1)
  (while (search-forward-regexp cobol-struct nil t)
    (setq level cobol-struct-level)
    (beginning-of-line)
    (setq start (point))
    (move-to-column level)
    (delete-region start (point))
    (while (> level 0)
      (setq level (- level 1))
      (insert "1"))))



(defun cobol-outline-source ()
  "*Add level-markers for outline minor-mode to DIVISIONs, SECTIONs etc."

  (interactive)

  (setq count 0)

  (while (< count 4)
    ;; get indent pattern and level from list
    (setq cobol-struct-el (nth count cobol-struct-list))
    (setq pat (nth 0 cobol-struct-el))
    (setq ind (nth 1 cobol-struct-el))
    ;; add trailing spaces
    (setq pal (- 7 ind))
    (while (> pal 0)
      (setq pal (- pal 1))
      (setq pat (concat " " pat)))
    ;; add regexs for trailing "* or space"
    (setq pal ind)
    (while (> pal 0)
      (setq pal (- pal 1))
      (setq pat (concat "[1 ]" pat)))
    ;; always from BOL
    (setq pat (concat "^" pat))
    ;; testing
    (message (concat "ClOMO: Marking level " ind " for outline mode..."))
    ;; mark
    (cobol-mark-struct pat ind)
    ;; count
    (setq count (+ count 1)))

  (message nil)
  (outline-minor-mode t))

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

(defun cobol-reload-mode ()
  "*Reload COBOL major mode to active bug-fixes. Useful while ß-testing in net."
  (interactive)
  (setq cobol-azou-flag 0)
  (load-file "/u1/wcn26/lisp/devclo.el")
  (font-lock-fontify-buffer))

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

(defun cobol-hide-html ()
  "*Hide trailing HTML-sections in a COBOL-source."

  (interactive)

  (goto-char 1)
  (if (search-forward cobol-string-start-region nil t)
      (progn
	(setq start (point))
	(search-forward cobol-string-end-region)
	(search-backward "      ")
	(narrow-to-region start (point)))))



(defun cobol-htmlify-source ()
  "Make list of sections and append it to source. Make HREFs to sections."

  (interactive)

  (setq cobol-fun-list "</P><HR><OL>")

  (widen)
  (goto-char 1)
  (if (search-forward cobol-string-start-region nil t)
      (message "Updating HTML information...")
      ;;else
    (message "Creating HTML information...")
    (goto-char 1)
    (insert cobol-html-head)
    (goto-char (point-max))
    (insert cobol-html-foot)
    (goto-char 1)
    (search-forward cobol-string-start-region))

  (goto-char 1)
  (while (search-forward-regexp (concat "^" cobol-string-auto-name) nil t)
    (beginning-of-line)
    (setq start (point))
    (move-to-column 1)
    (search-forward-regexp "^")
    (delete-region start (point)))

  (goto-char 1)
  (while (search-forward-regexp "^       [-A-Za-z0-9_]+[ \t]\\(SECTION\\|section\\)" nil t)
    (setq start (point))
    (move-to-column 7)
    (setq cobol-fun (buffer-substring start (point)))
    (beginning-of-line)
    (insert (concat cobol-string-auto-name "*<A NAME=\"" cobol-fun "\"><H4>" cobol-fun "</H4>\n"))
    (setq cobol-fun (concat "\n      *<LI><A HREF=\"#" cobol-fun "\">" cobol-fun "</A>"))
    (search-forward ".")
    (setq cobol-fun-list (concat cobol-fun-list cobol-fun)))
  (goto-char 1)
  (search-forward cobol-string-end-region)
  (setq start (point))
  (search-forward cobol-string-end-index)
  (delete-region start (point))
  (insert (concat cobol-fun-list "\n      *</OL></P><HR>" cobol-string-end-index))
  (cobol-hide-html)
  (message nil))


(defun cobol-spinnerize-source ()
  "Make HTML-outline of source for the Spider/Spinner/Roxen WWW server."

  (interactive)

  (cobol-outline-source)

  (setq else-string "</MENU></ELSE>")
  (setq counter 0)

  (widen)
  (goto-char 1)
  (if (search-forward cobol-string-start-region nil t)
      (message "Updating Spinner information...")
      ;;else
    (message "Creating Spinner information...")
    (goto-char 1)
    (insert cobol-html-head)
    (goto-char (point-max))
    (insert cobol-html-foot)
    (goto-char 1)
    (search-forward cobol-string-start-region))

  (goto-char 1)
  (while (search-forward-regexp (concat "^" cobol-string-auto-name) nil t)
    (beginning-of-line)
    (setq start (point))
    (move-to-column 1)
    (search-forward-regexp "^")
    (delete-region start (point)))

  (cobol-hide-html)

  (setq ll 0)
  (goto-char 1)
  (while (search-forward-regexp "^1[1 ][1 ][1 ][1 ] " nil t)
    (setq counter (+ counter 1))         ;# of section

    (beginning-of-line)                  ;determine depth
    (setq bol (point))
    (search-forward " " nil t)
    (setq lvl (- (point) bol))

    (end-of-line)                        ;determine title for section
    (if (> (- (point) bol) 72)
	(goto-char 72))
    (search-backward-regexp "[^ \t]" nil t)
    (setq end (+ (point) 1))
    (move-to-column 7)
    (setq cobol-fun (buffer-substring (point) end))
    (message (concat "Spinnerizing " cobol-fun "..."))

    (beginning-of-line)                  ;insert appropriate # of </ELSE>s
    (insert (concat cobol-string-auto-name "*"))

    (if (<= lvl ll)
	(progn
	  (setq lvlc (- ll lvl))
	  (while (>= lvlc 0)
	    (insert else-string)
	    (setq lvlc (- lvlc 1)))))
    (setq ll lvl)

    (insert (concat "<A NAME=\"" cobol-fun "\"><IF NOT PRESTATE=s" counter
		    "><H4><APRE s" counter 
		    "><IMG BORDER=\"0\" SRC=\"/image/unfold.gif\"></APRE>"
		    cobol-fun "</H4></IF>"
		    "<ELSE>"
		    "<H4><APRE -s" counter 
		    "><IMG BORDER=\"0\" SRC=\"/image/fold.gif\"></APRE>"
		    cobol-fun "</H4><MENU>\n"))
    (end-of-line))

  (widen)
  (goto-char 1)
  (search-forward cobol-string-end-region)
  (beginning-of-line)
  (insert (concat cobol-string-auto-name "*"))
  (while (> ll 1)
    (insert else-string)
    (setq ll (- ll 1)))
  (insert "<HR>\n")

  (search-forward cobol-string-end-region)
  (setq start (point))
  (search-forward cobol-string-end-index)
  (delete-region start (point))
  (insert cobol-string-end-index)

  (setq counter 0)
  (setq cobol-fun "Notice")
  (goto-char 1)
  (end-of-line)
  (goto-char (+ (point) 1))
  (insert cobol-string-auto-name "*")
  (insert (concat "<A NAME=\"" cobol-fun "\"><IF NOT PRESTATE=s" counter
		    "><H4><APRE s" counter 
		    "><IMG BORDER=\"0\" SRC=\"/image/unfold.gif\"></APRE>"
		    cobol-fun "</H4></IF>"
		    "<ELSE>"
		    "<H4><APRE -s" counter 
		    "><IMG BORDER=\"0\" SRC=\"/image/fold.gif\"></APRE>"
		    cobol-fun "</H4><MENU>\n"))
  (if (search-forward cobol-string-start-region nil t)
      (progn
	(beginning-of-line)
	(insert cobol-string-auto-name "*" else-string "\n")))

  (cobol-hide-html)
  (message nil))

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

(defun cobol-help-bugs (foo)
  "Information on the bugs in COBOL-mode."
  (end-of-buffer)
  (insert (concat "\n\nBUGS & FEATURES\n\n"
		  "This is a tough one since the original documentation was\n"
		  "not passed on to me together with the project (and then,\n"
		  "it was in German, too). So on some items, it's really\n"
		  "hard to tell whether they're bugs or features (and it's\n"
		  "just me expecting the wrong things and not sure how to\n"
		  "measure success). An example for this is the abbreviation\n"
		  "mode that listens when you type \";\" and a number of\n"
		  "letters. I feel these should be expanded somehow, but\n"
		  "they aren't, and since I am a fast typist, I have other\n"
		  "priorities, but you get the picture...\n\n"

		  "KNOWN PROBLEMS:\n"
		  "- The Nassifier only works with COBOL-74 sources.\n"

		  "\n"
		  "If you discover other bugs or fix or extend ClOMO, please mail\n\n"
		  "\tAzundris <azundris@thepentagon.com>\n\n")))

(defun cobol-help-menus (foo)
  "Information on the menus in COBOL-mode."
  (end-of-buffer)
  (insert (concat "\n\nDEVELOPMENT\n\n"

		  "Compiler call\n"
		  "Call the COBOL-compiler to translate the current buffer.\n"
		  "ClOMO uses the following environment variables to determine\n"
		  "how to call the compiler:\n\n"
		  "variable explanation                             default\n"
		  "COMO_P   switches for compiling a program        \"-xvP\"\n"
		  "COMO_L   switches for compiling a module         \"-xvcP\"\n"
		  "COMO_C   (path and) name for the compiler call   \"cob\"\n"
		  "COMO_H   remote server. *if* this is set, clomo  \"\"\n"
		  "         tries to \"rsh\" $COMO_C on the specified\n"
		  "         host. A \"cd\" to the current directory\n"
		  "         will be added to the remote command,\n"
		  "         assuming the file-system is similar\n"
		  "         (as in, NFS-mounted).\n\n"

		  "Restart COBOL-mode\n"
		  "This should only be relevant for the developress.\n\n"

		  "Remove spaces\n"
		  "Removes excess spaces and carriage returns in the source.\n"
		  "Use this if \"HTMLify/SPLMify/Nassify source\" behave\n"
		  "strangely.\n\n"

		  "ToUpper source\n"
		  "COBOL-74 sources have to be in uppercase.\n"
		  "If you do not fancy typing it that way, you can add it\n"
		  "later. More importantly, this is useful if you need to\n"
		  "port something (back) to COBOL-74.\n\n"

		  "Outline source\n"
		  "Analyzes the structure of a COBOL-source and switches on\n"
		  "xemacs' outline-mode (which adds the Headings, Show and\n"
		  "Hide menus) so you can fold in the information you don't\n"
		  "need to see. ->SPLMify source\n\n"

		  "HTMLify/SPLMify source\n"
		  "HTMLify adds information so that when viewed using a\n"
		  "WWW-browser, the source will look nice and have jumpmarks.\n"
		  "(The source will still compile with the COBOL-compiler.)\n"
		  "For this to work, your web-server will have to send\n"
		  "files with your COBOL-extension (say, \".cbl\") as\n"
		  "MIME-type \"text/html\" -- if in doubt, ask your local guru.\n"
		  "Alternately, this can be accomplished by creating a symbolic\n"
		  "link ('ln -s name.cbl name.html').\n"
		  "SPLMify also adds information for the folding/unfolding\n"
		  "of the source (->outline source). This will only work with\n"
		  "the Spider/Spinner/Roxen WWW-servers. (The Outline-mode\n"
		  "for Roxen is not required for this. Special support for\n"
		  "this mode may follow at a later date.\n\n"

		  "Nassify source\n"
		  "Generates a LaTeX-source. If you have LaTeX and the\n"
		  "Nassi-Shneiderman-style for LaTeX, this can be used for\n"
		  "printing (or viewing) a NS-diagram of the source. This is\n"
		  "useful if you have to service old sources for which no\n"
		  "documentation exists. For that reason, the main concern\n"
		  "was to make this work for COBOL-74. It works beautifully\n"
		  "on my test-file, but nasty code or COBOL-85 will almost\n"
		  "certainly break the converter which is still \"under\n"
		  "construction\" at best.\n"
		  "- Include warnings\n"
		  "  The converter issues error messages (notices\n"
		  "  of severe problems that will most certainly\n"
		  "  render the output nonsense) and warning messages\n"
		  "  (notices of possible problems or \"bad style\").\n"
		  "  The latter can be switched off.\n"
		  "- Include debug info\n"
		  "  This should be of interest to the developress only.\n"
		  "  Includes a lot of information about how the\n"
		  "  converter interpreted the code.\n\n"

		  "Highlight COBOL-74\n"
		  "If set, the fontlock will only recognize COBOL-keywords\n"
		  "in uppercase letters.\n\n"

		  "INSERT\n\n"
		  "Inserts constructs or program parts where sensible.\n")))

(provide 'cobol-mode)

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; ENDS
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;