;; COBOL-Mode.el -- A major mode for editing COBOL source.

;; Author: Zastai <zastai@hotmail.com>
;; Keywords: languages

;;; Commentary:

;; Currently only hase the mode function, a hook, and variables 
;;  for fontification through font-lock-mode.

;;; Code:

(eval-and-compile
  (condition-case ()
      (require 'custom)
    (error nil))
  (if (and (featurep 'custom) (fboundp 'custom-declare-variable))
      nil
    (defmacro defgroup (&rest args)
      nil)
    (defmacro defcustom (var value doc &rest args)
      (` (defvar (, var) (, value) (, doc))))))

(defgroup cobol-mode nil
  "A major mode for editing COBOL source."
  :tag "COBOL Mode"
  :group 'languages
  )

(defcustom cobol-mode-hook nil
  "*Hook run at startup by `cobol-mode'."
  :type 'hook
  :tag "COBOL Mode Hook"
  :group 'cobol-mode
  )

(defconst cobol-functions
  (concat ""
	  ;; A -
	  ""
	  ;; B -
	  ""
	  ;; C -
	  ""
	  ;; D -
	  ""
	  ;; E -
	  ""
	  ;; F -
	  ""
	  ;; G -
	  ""
	  ;; H -
	  ""
	  ;; I -
	  ""
	  ;; J -
	  ""
	  ;; K - none
	  ""
	  ;; L -
	  ""
	  ;; M -
	  ""
	  ;; N -
	  ""
	  ;; O -
	  ""
	  ;; P -
	  ""
	  ;; Q -
	  ""
	  ;; R -
	  ""
	  ;; S -
	  ""
	  ;; T -
	  ""
	  ;; U -
	  ""
	  ;; V -
	  ""
	  ;; W -
	  ""
	  ;; XYZ -
	  ""
  )
  "Regexp that expands to all supported COBOL functions.

These are:
")

(defconst cobol-data-types
  (concat ""
	  ;; A -
	  ""
	  ;; B -
	  ""
	  ;; C -
	  ""
	  ;; D -
	  ""
	  ;; E -
	  ""
	  ;; F -
	  ""
	  ;; G -
	  ""
	  ;; H -
	  ""
	  ;; I -
	  ""
	  ;; J -
	  ""
	  ;; K - none
	  ""
	  ;; L -
	  ""
	  ;; M -
	  ""
	  ;; N -
	  ""
	  ;; O -
	  ""
	  ;; P -
	  ""
	  ;; Q -
	  ""
	  ;; R -
	  ""
	  ;; S -
	  ""
	  ;; T -
	  ""
	  ;; U -
	  ""
	  ;; V -
	  ""
	  ;; W -
	  ""
	  ;; XYZ -
	  ""
  )
  "Regexp that expands to all supported COBOL data types.

These are:
")

(defconst cobol-keywords
  (concat ""
	  ;; A -
	  "A\\(CCE\\(PT\\|SS\\)\\|D\\(D\\(\\|RESS\\)\\|VANCING\\)\\|FTER\\|"
	  "L\\(L\\|PHA\\(BET\\(\\|IC\\(\\|-\\(LOW\\|UPP\\)ER\\)\\)\\|NUMERIC"
	  "\\(\\|-EDITED\\)\\)\\|SO\\|TER\\(\\|NATE\\)\\)\\|N[DY]\\|PPLY\\|"
	  "RE\\(\\|A[S]?\\)\\|S\\(C\\(ENDING\\|II\\)\\|SIGN\\)\\|T\\(\\|"
	  "-END\\)\\|UTHOR\\)\\|"
	  ;; B - BASIS BEFORE BEGINNING BINARY BLANK BLOCK BY
	  "B\\(ASIS\\|E\\(FORE\\|GINNING\\)\\|INARY\\|L\\(ANK\\|OCK\\)\\Y\\)"
	  "\\|"
	  ;; C - CALL CANCEL CBL CD CF CH CHARACTER CHARACTERS CLASS CLOSE
	  ;; COBOL CODE CODE-SET COLLATING COLUMN COMMA COMMIT COMMUNICATION
	  ;; COMP(UTATIONAL) COMP(UTATIONAL)-1 COMP(UTATIONAL)-2
	  ;; COMP(UTATIONAL)-3 COMP(UTATIONAL)-4 COMPUTE CONFIGURATION
	  ;; CONTAINS CONTENT CONTINUE CONTROL CONVERTING COPY CORR
	  ;; CORRESPONDING COUNT CURRENCY
	  "C\\(A\\(LL\\|NCEL\\)\\|BL\\|[DF]\\|H\\(\\|ARACTERS?\\)\\|L\\(ASS\\|"
	  "OSE\\)\\|O\\(BOL\\|DE\\(\\|-SET\\)\\|L\\(LATING\\|UMN\\)\\|M\\(M\\("
	  "A\\|IT\\|UNICATION\\)\\|P\\(\\|-[1234]\\|UT\\(ATIONAL\\(\\|-[1234]"
	  "\\)\\|E\\)\\)\\)\\|N\\(FIGURATION\\|T\\(AINS\\|ENT\\|INUE\\|ROL\\)"
	  "\\|VERTING\\)\\|PY\\|RR\\(\\|ESPONDING\\)\\|UNT\\)\\|URRENCY\\)\\|"
	  ;; D - DATA DATE DATE-COMPILED DATE-WRITTEN DAY DAY-OF-WEEK DBCS
	  ;; 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 DETAIL DISABLE
	  ;; DISPLAY DIVIDE DIVISION DUPLICATES DYNAMIC
	  ""
	  ;; E - EBCDIC EGCS EGI EJECT ELSE EMI ENABLE END 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-SUBTRACT
	  ;; END-UNSTRING END-WRITE ENDING ENTER ENTRY ENVIRONMENT EOP EQUAL
	  ;; ERROR ESI EVALUATE EVERY EXCEPTION EXIT EXTEND EXTERNAL
	  ""
	  ;; F - FALSE FD FILE FILE-CONTROL FILLER FINAL FIRST FOOTING FOR
	  ;; FROM FUNCTION
	  "F\\(ALSE\\|D\\|I\\(L\\(E\\(\\|-CONTROL\\)\\|LER\\)\\|NAL\\|RST\\)"
	  "\\|O\\(OTING\\|R\\)\\|ROM\\|UNCTION\\)\\|"
	  ;; G - GENERATE GIVING GO GOBACK GREATER GROUP
	  "G\\(ENERATE\\|IVING\\|O\\(\\|BACK\\)\\|R\\(EATER\\|OUP\\)\\)\\|"
	  ;; H - HEADING HIGH-VALUE HIGH-VALUES
	  "H\\(EADING\\|IGH-VALUES?\\)\\|"
	  ;; I - I-O I-O-CONTROL ID IDENTIFICATION IF IN INDEX INDEXED INDICATE
	  ;; INITIAL INITIALIZE INITIATE INPUT INPUT-OUTPUT INSERT INSPECT
	  ;; INSTALLATION INTO INVALID IS
	  ""
	  ;; J - JUST JUSTIFIED
	  "JUST\\(\\|IFIED\\)\\|"
	  ;; K - KANJI KEY
	  "K\\(ANJI\\|EY\\)\\|"
	  ;; L - LABEL LAST LEADING LESS LENGTH LIMIT LIMITS LINAGE
	  ;; LINAGE-COUNTER LINE LINE-COUNTER LINES LINKAGE LOCK LOW-VALUE
	  ;; LOW-VALUES
	  ""
	  ;; M - MEMORY MERGE MESSAGE MODE MODULES MOVE MULTIPLE MULTIPLY
	  "M\\(E\\(MORY\\|RGE\\|SSAGE\\)\\|O\\(D\\(E\\|ULES\\)\\|VE\\)\\|"
	  "ULTIPL[EY]\\)\\|"
	  ;; N - NATIVE NEGATIVE NEXT NO NOT NULL NULLS NUMBER NUMERIC
	  ;; NUMERIC-EDITED
	  "N\\(ATIVE\\|E\\(GATIVE\\|XT\\)\\|OT?\\|U\\(LLS?\\|M\\(BER\\|ERIC"
	  "\\(\\|-EDITED\\)\\)\\)\\)\\|"
	  ;; O - OBJECT-COMPUTER OCCURS OF OFF OMITTED ON OPEN OPTIONAL OR
	  ;; ORGANIZATION OUTPUT OVERFLOW
	  "O\\(BJECT-COMPUTER\\|CCURS\\|FF?\\|MITTED\\|N\\|P\\(EN\\|TIONAL\\)"
	  "\\|R\\(\\|GANIZATION\\)\\|UTPUT\\|VERFLOW\\)\\|"
	  ;; P - PACKED-DECIMAL PADDING PAGE PAGE-COUNTER PASSWORD PERFORM
	  ;; PF PH PIC PICTURE PLUS POINTER POSITION POSITIVE PRINTING PRIOR
	  ;; PROCEDURE PROCEED PROGRAM PROGRAM-ID PURGE
	  ""
	  ;; Q - QUEUE QUOTE QUOTES
	  "QU\\(EUE\\|OTES?\\)\\|"
	  ;; R - RANDOM RD READ RECEIVE RECORD RECORDING RECORDS RECORD
	  ;; RECURSIVE REDEFINES REEL REFERENCE RELATIVE RELEASE REMAINDER
	  ;; REMOVAL RENAMES REPLACE REPLACING RF REPORT REPORTING REPORTS
	  ;; RERUN RESERVE RETURN RETURN-CODE REVERSED REWIND REWRITE RH
	  ;; ROUNDED RUN
	  ""
	  ;; S - SAME SD SEARCH SECTION SECURITY SEGMENT SEGMENT-LIMIT
	  ;; SELECT SEND SENTENCE SEPARATE SEQUENCE SEQUENTIAL SET SHIFT-IN
	  ;; SHIFT-OUT SIGN SIZE SKIP1 SKIP2 SKIP3 SORT SORT-CONTROL
	  ;; SORT-CORE-SIZE SORT-FILE-SIZE SORT-MESSAGE SORT-MODE-SIZE
	  ;; SORT-RETURN SOURCE SOURCE-COMPUTER SPACE SPACES SPECIAL-NAMES
	  ;; STANDARD STANDARD-1 STANDARD-2 START STATUS STOP STRING
	  ;; SUB-QUEUE-1 SUB-QUEUE-2 SUB-QUEUE-3 SUBTRACT SUPPRESS SYMBOLIC
	  ;; SYNC SYNCHRONIZED
	  ""
	  ;; T - TABLE TALLY TALLYING TAPE TERMINAL TEST TEXT THAN THEN THROUGH
	  ;; THRU TIME TIMES TITLE TO TRAILING TRUE TYPE
	  "T\\(A\\(BLE\\|LLY\\(\\|ING\\)\\|PE\\)\\|E\\(RMINAL\\|ST\\|XT\\)\\|"
	  "H\\(AN\\|EN\\|ROUGH\\|RU\\)\\|I\\(\\)\\|O\\|R\\(AILING\\|UE\\)\\|"
	  "YPE\\)\\|"
	  ;; U - UNIT UNLOCK UNSTRING UNTIL UPON UPSI USAGE USE USING
	  "U\\(N\\(IT\\|LOCK\\|STRING\\|TIL\\)\\|P\\(ON\\|SI\\)\\|S\\(AGE\\|"
	  "E\\|ING\\)\\)\\|"
	  ;; V - VALUE VALUES VARYING
	  "VA\\(LUES?\\|RYING\\)\\|"
	  ;; W - WHEN WHEN-COMPILED WITH WORDS WORKING-STORAGE WRITE WRITE-ONLY
	  "W\\(HEN\\(\\|-COMPILED\\)\\|ITH\\|OR\\(DS\\|KING-STORAGE\\)\\|RITE"
	  "\\(\\|-ONLY\\)\\)\\|"
	  ;; XYZ - ZERO ZEROES ZEROS
	  "ZEROE?S?"
  )
  "Regexp that expands to all supported COBOL keywords.

These are:
  ACCEPT
  ACCESS
  ADD
  ADDRESS OF
  ADVANCING
  AFTER
  ALL
  ALPHABET
  ALPHABETIC
  ALPHABETIC-LOWER
  ALPHABETIC-UPPER
  ALPHANUMERIC
  ALPHANUMERIC-EDITED
  ALSO
  ALTER
  ALTERNATE
  AND
  ANY
  APPLY
  ARE
  AREA
  AREAS
  ASCENDING
  ASCII
  ASSIGN
  AT
  AT-END
  AUTHOR
  BASIS
  BEFORE
  BEGINNING
  BINARY
  BLANK
  BLOCK
  BY
  CALL
  CANCEL
  CBL
  CD
  CF
  CH
  CHARACTER
  CHARACTERS
  CLASS
  CLOSE
  COBOL
  CODE
  CODE-SET
  COLLATING
  COLUMN
  COMMA
  COMMIT
  COMMUNICATION
  COMP
  COMP-1
  COMP-2
  COMP-3
  COMP-4
  COMPUTATIONAL
  COMPUTATIONAL-1
  COMPUTATIONAL-2
  COMPUTATIONAL-3
  COMPUTATIONAL-4
  COMPUTE
  CONFIGURATION
  CONTAINS
  CONTENT
  CONTINUE
  CONTROL
  CONVERTING
  COPY
  CORR
  CORRESPONDING
  COUNT
  CURRENCY
  DATA
  DATE
  DATE-COMPILED
  DATE-WRITTEN
  DAY
  DAY-OF-WEEK
  DBCS
  DE
  DEBUG-CONTENTS
  DEBUG-ITEM
  DEBUG-LINE
  DEBUG-NAME
  DEBUG-SUB-1
  DEBUG-SUB-2
  DEBUG-SUB-3
  DEBUGGING
  DECIMAL-POINT
  DECLARATIVES
  DELETE
  DELETE FILE
  DELIMITED
  DELIMITER
  DEPENDING
  DESCENDING
  DETAIL
  DISABLE
  DISPLAY
  DIVIDE
  DIVISION
  DUPLICATES
  DYNAMIC
  EBCDIC
  EGCS
  EGI
  EJECT
  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-SUBTRACT
  END-UNSTRING
  END-WRITE
  ENDING
  ENTER
  ENTRY
  ENVIRONMENT
  EOP
  EQUAL
  ERROR
  ESI
  EVALUATE
  EVERY
  EXCEPTION
  EXIT
  EXTEND
  EXTERNAL
  FALSE
  FD
  FILE
  FILE-CONTROL
  FILE STATUS
  FILLER
  FINAL
  FIRST
  FOOTING
  FOR
  FROM
  FUNCTION
  GENERATE
  GIVING
  GO
  GOBACK
  GREATER
  GROUP
  HEADING
  HIGH-VALUE
  HIGH-VALUES
  I-O
  I-O-CONTROL
  ID
  IDENTIFICATION
  IF
  IN
  INDEX
  INDEXED
  INDICATE
  INITIAL
  INITIALIZE
  INITIATE
  INPUT
  INPUT-OUTPUT
  INSERT
  INSPECT
  INSTALLATION
  INTO
  INVALID
  IS
  JUST
  JUSTIFIED
  KANJI
  KEY
  LABEL
  LAST
  LEADING
  LESS
  LENGTH OF
  LIMIT
  LIMITS
  LINAGE
  LINAGE-COUNTER
  LINE
  LINE-COUNTER
  LINES
  LINKAGE
  LOCK
  LOW-VALUE
  LOW-VALUES
  MEMORY
  MERGE
  MESSAGE
  MODE
  MODULES
  MOVE
  MULTIPLE
  MULTIPLY
  NATIVE
  NEGATIVE
  NEXT
  NO
  NOT
  NULL
  NULLS
  NUMBER
  NUMERIC
  NUMERIC-EDITED
  OBJECT-COMPUTER
  OCCURS
  OF
  OFF
  OMITTED
  ON
  OPEN
  OPTIONAL
  OR
  ORGANIZATION
  OUTPUT
  OVERFLOW
  PACKED-DECIMAL
  PADDING
  PAGE
  PAGE-COUNTER
  PASSWORD
  PERFORM
  PF
  PH
  PIC
  PICTURE
  PLUS
  POINTER
  POSITION
  POSITIVE
  PRINTING
  PRIOR
  PROCEDURE
  PROCEED
  PROGRAM
  PROGRAM-ID
  PURGE
  QUEUE
  QUOTE
  QUOTES
  RANDOM
  RD
  READ
  RECEIVE
  RECORD
  RECORDING
  RECORDS
  RECORD Clause
  RECURSIVE
  REDEFINES
  REEL
  REFERENCE
  RELATIVE
  RELEASE
  REMAINDER
  REMOVAL
  RENAMES
  REPLACE
  REPLACING
  RF
  REPORT
  REPORTING
  REPORTS
  RERUN
  RESERVE
  RETURN
  RETURN-CODE
  REVERSED
  REWIND
  REWRITE
  RH
  ROUNDED
  RUN
  SAME
  SD
  SEARCH
  SECTION
  SECURITY
  SEGMENT
  SEGMENT-LIMIT
  SELECT
  SEND
  SENTENCE
  SEPARATE
  SEQUENCE
  SEQUENTIAL
  SET
  SHIFT-IN
  SHIFT-OUT
  SIGN
  SIZE
  SKIP1
  SKIP2
  SKIP3
  SORT
  SORT-CONTROL
  SORT-CORE-SIZE
  SORT-FILE-SIZE
  SORT-MESSAGE
  SORT-MODE-SIZE 
  SORT-RETURN
  SOURCE
  SOURCE-COMPUTER
  SPACE
  SPACES
  SPECIAL-NAMES
  STANDARD
  STANDARD-1
  STANDARD-2
  START
  STATUS
  STOP
  STRING
  SUB-QUEUE-1
  SUB-QUEUE-2
  SUB-QUEUE-3
  SUBTRACT
  SUPPRESS
  SYMBOLIC
  SYNC
  SYNCHRONIZED
  TABLE
  TALLY
  TALLYING
  TAPE
  TERMINAL
  TEST
  TEXT
  THAN
  THEN
  THROUGH
  THRU
  TIME
  TIMES
  TITLE
  TO
  TRAILING
  TRUE
  TYPE
  UNIT
  UNLOCK
  UNSTRING
  UNTIL
  UPON
  UPSI
  USAGE
  USE
  USING
  VALUE
  VALUES
  VARYING 
  WHEN
  WHEN-COMPILED
  WITH
  WORDS
  WORKING-STORAGE
  WRITE
  WRITE-ONLY
  ZERO
  ZEROES
  ZEROS
")

(defconst cobol-font-lock-keywords
  (list
   ;; the comments
   (cons "^      \\*.+$" '(0 'font-lock-comment-face t))
   ;; the keywords
   (cons (concat "\\<\\(" cobol-keywords "\\)\\>") 'font-lock-keyword-face)
   ;; the types -- both named types and the field leaders.
   (cons (concat "\\<\\(" cobol-data-types "\\)\\>") 'font-lock-type-face)
   (cons "^ +\\(77\\|88\\|99\\|[0-4][0-9]\\) " 'font-lock-type-face)
   ;; the functions
   (cons (concat "\\<\\(" cobol-functions "\\)\\>") 
	 'font-lock-function-name-face)
  )
)

(defvar cobol-mode-map nil
  "The keymap and menus used in COBOL Mode.")
(if cobol-mode-map ()
  (setq cobol-mode-map (make-sparse-keymap))

  (define-key cobol-mode-map [menu-bar] (make-sparse-keymap))
  (define-key cobol-mode-map [menu-bar cobol-mode] 
    (cons "COBOL" (make-sparse-keymap "COBOL")))
)

;;;###autoload
(defun cobol-mode ()
  "Major mode for editing COBOL source code.
The hook variable `cobol-mode-hook' is run at startup.
Nothing much is done yet, besides fontification.

Key Bindings for COBOL Mode:
\\{cobol-mode-map}
"

  (interactive)
  (kill-all-local-variables)
  (make-local-variable 'font-lock-defaults)
  (use-local-map cobol-mode-map)

  (setq major-mode 'cobol-mode mode-name "COBOL")
  (setq font-lock-defaults '(cobol-font-lock-keywords nil t))

  (make-local-variable 'comment-start)
  (make-local-variable 'comment-end)
  (make-local-variable 'comment-column)
  (make-local-variable 'comment-start-skip)
  (make-local-variable 'comment-multi-line)

  (setq comment-start "*"
 	comment-end   ""
	comment-column 7
 	comment-multi-line nil)

  (modify-syntax-entry ?- "w")
  (modify-syntax-entry ?\" "\"")
  (modify-syntax-entry ?' "\"")

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

(provide 'cobol-mode)
