home *** CD-ROM | disk | FTP | other *** search
/ InfoMagic Source Code 1993 July / THE_SOURCE_CODE_CD_ROM.iso / languages / elisp / modes / cobol.el < prev    next >
Encoding:
Text File  |  1990-10-30  |  32.6 KB  |  818 lines
  1. ;;; Cobol mode for GNU Emacs (version 1.01, Jun 21, 1988)
  2. ;;; Copyright (c) 1987 Free Software Foundation, Inc.
  3. ;;; Written by Robert A Sutterfield (bob@cis.ohio-state.edu) and
  4. ;;;  Paul W. Placeway (paul@tut.cis.ohio-state.edu), as changes to fortran.el
  5. ;;; Bugs to bug-cobol-mode@cis.ohio-state.edu
  6.  
  7. ;;;    [0) the left column is column 1]
  8. ;;;  +  1) newline should indent to the same column as the start of
  9. ;;;        the previous line
  10. ;;;  +  2) tabs at 8 and every four thereafter (12, 16, 20, etc.)
  11. ;;;  +  3) tabs should be expanded to spaces on input
  12. ;;;  +  (3a) no tabs should appear in the buffer
  13. ;;;  no 4) right margin bell at 72 (hard to do)
  14. ;;;  +  5) (optional) flash matching parentheses
  15. ;;;  +  6) no auto-fill (WHY -- PWP) (not by default)
  16. ;;;  *  7) auto startup on .cob files
  17. ;;;       To do this, the expression ("\\.cob$" . cobol-mode) must be
  18. ;;;       added to loaddefs.el in the gnu-emacs lisp directory, and
  19. ;;;       loaddefs must be re-byte-code-compiled.
  20. ;;;       Also, an autoload must be set up for cobol-mode in loaddefs.el;
  21. ;;;       see the loaddefs.el file in this directory.
  22. ;;;  +  8) auto indent to that of the last line (more magic than that...)
  23. ;;;  +  9) delete on a blank line should go back to LAST tab stop
  24. ;;;  + 10) C-c C-c moves cursor to ARG (or prompted) column, adding
  25. ;;;        spaces to get there if needed
  26. ;;;    11) C-c C-l does (goto-line)
  27. ;;;
  28. ;;; COBOL mode adapted from:
  29. ;;;; Fortran mode for GNU Emacs  (beta test version 1.21, Oct. 1, 1985)
  30. ;;;; Copyright (c) 1986 Free Software Foundation, Inc.
  31. ;;;; Written by Michael D. Prange (mit-eddie!mit-erl!prange).
  32. ;;;; Author acknowledges help from Stephen Gildea <mit-erl!gildea>
  33.  
  34. ;; This file is not part of the GNU Emacs distribution (yet).
  35.  
  36. ;; This file is distributed in the hope that it will be useful,
  37. ;; but WITHOUT ANY WARRANTY.  No author or distributor
  38. ;; accepts responsibility to anyone for the consequences of using it
  39. ;; or for whether it serves any particular purpose or works at all,
  40. ;; unless he says so in writing.  Refer to the GNU Emacs General Public
  41. ;; License for full details.
  42.  
  43. ;; Everyone is granted permission to copy, modify and redistribute
  44. ;; this file, but only under the conditions described in the
  45. ;; GNU Emacs General Public License.   A copy of this license is
  46. ;; supposed to have been given to you along with GNU Emacs so you
  47. ;; can know your rights and responsibilities.  It should be in a
  48. ;; file named COPYING.  Among other things, the copyright notice
  49. ;; and this notice must be preserved on all copies.
  50.  
  51. ;; Bugs to bug-cobol-mode@cis.ohio-state.edu.
  52.  
  53. (defvar cobol-do-indent 4
  54.   "*Extra indentation applied to `do' blocks.")
  55.  
  56. (defvar cobol-if-indent 4
  57.   "*Extra indentation applied to `if' blocks.")
  58.  
  59. (defvar cobol-continuation-indent 6
  60.   "*Extra indentation applied to `continuation' lines.")
  61.  
  62. (defvar cobol-pic-column 50
  63.   "*The column that PIC clauses should be aligned to.")
  64.  
  65. (defvar cobol-indent-increment 4
  66.   "*Amount of indentation to add to a line when it can be indented.")
  67.  
  68. (defvar cobol-comment-indent-style 'fixed
  69.   "*nil forces comment lines not to be touched,
  70. 'fixed produces fixed comment indentation to comment-column,
  71. and 'relative indents to current cobol indentation plus comment-column.")
  72.  
  73. (defvar cobol-comment-line-column 6
  74.   "*Indentation for text in comment lines.")
  75.  
  76. (defvar comment-line-start nil
  77.   "*Delimiter inserted to start new full-line comment.")
  78.  
  79. (defvar comment-line-start-skip nil
  80.   "*Regexp to match the start of a full-line comment.")
  81.  
  82. (defvar cobol-minimum-statement-indent 7     ;;; this puts it in column 8
  83.   "*Minimum indentation for cobol statements.")
  84.  
  85. ;; Note that this is documented in the v18 manuals as being a string
  86. ;; of length one rather than a single character.
  87. ;; The code in this file accepts either format for compatibility.
  88. (defvar cobol-comment-indent-char " "
  89.   "*Character to be inserted for Cobol comment indentation.
  90. Normally a space.")
  91.  
  92. (defvar cobol-line-number-indent 1
  93.   "*Maximum indentation for Cobol line numbers.
  94. 6 means right-justify them within their six-column field.")
  95.  
  96. (defvar cobol-check-all-num-for-matching-do nil
  97.   "*Non-nil causes all numbered lines to be treated as possible do-loop ends.")
  98.  
  99. (defvar cobol-continuation-char ?-
  100.   "*Character which is inserted in column 7 by \\[cobol-split-line]
  101. to begin a continuation line.  Normally ?-")
  102.  
  103. (defvar cobol-comment-region "      ** "
  104.   "*String inserted by \\[cobol-comment-region] at start of each line in region.")
  105.  
  106. (defvar cobol-electric-line-number t
  107.   "*Non-nil causes line number digits to be moved to the correct column as typed.")
  108.  
  109. (defvar cobol-startup-message t
  110.   "*Non-nil displays a startup message when cobol-mode is first called.")
  111.  
  112. (defvar cobol-column-ruler
  113.   (concat "0    00  1         2         3         4         5         6         7  2\n"
  114.       "1.../67..0..../....0..../....0..../....0..../....0..../....0..../....0..\n")
  115.   "*String displayed above current line by \\[cobol-column-ruler].")
  116.  
  117. (defconst cobol-mode-version "1.01")
  118.  
  119. (defvar cobol-mode-syntax-table nil
  120.   "Syntax table in use in cobol-mode buffers.")
  121.  
  122. (if cobol-mode-syntax-table
  123.     ()
  124.   (setq cobol-mode-syntax-table (make-syntax-table))
  125.   (modify-syntax-entry ?\; "w" cobol-mode-syntax-table)
  126.   (modify-syntax-entry ?+ "." cobol-mode-syntax-table)
  127.   (modify-syntax-entry ?- "." cobol-mode-syntax-table)
  128.   (modify-syntax-entry ?* "." cobol-mode-syntax-table)
  129.   (modify-syntax-entry ?/ "." cobol-mode-syntax-table)
  130.   (modify-syntax-entry ?\' "\"" cobol-mode-syntax-table)
  131.   (modify-syntax-entry ?\" "\"" cobol-mode-syntax-table)
  132.   (modify-syntax-entry ?\\ "/" cobol-mode-syntax-table)
  133.   (modify-syntax-entry ?. "w" cobol-mode-syntax-table)
  134.   (modify-syntax-entry ?\n ">" cobol-mode-syntax-table))
  135.  
  136. (defvar cobol-mode-map () 
  137.   "Keymap used in cobol mode.")
  138.  
  139. (if cobol-mode-map
  140.     ()
  141.   (setq cobol-mode-map (make-sparse-keymap)) ; this SHOULD be a real keymap
  142.   (define-key cobol-mode-map ";" 'cobol-abbrev-start)
  143.   (define-key cobol-mode-map "\C-c;" 'cobol-comment-region)
  144.   (define-key cobol-mode-map "\e\C-a" 'beginning-of-cobol-subprogram)
  145.   (define-key cobol-mode-map "\e\C-e" 'end-of-cobol-subprogram)
  146.   (define-key cobol-mode-map "\e;" 'cobol-indent-comment)
  147.   (define-key cobol-mode-map "\e\C-h" 'mark-cobol-subprogram)
  148.   (define-key cobol-mode-map "\e\n" 'cobol-split-line)
  149.   (define-key cobol-mode-map "\e\C-q" 'cobol-indent-subprogram)
  150.   (define-key cobol-mode-map "\C-c\C-w" 'cobol-window-create)
  151.   (define-key cobol-mode-map "\C-c\C-r" 'cobol-column-ruler)
  152.   (define-key cobol-mode-map "\C-c\C-p" 'cobol-previous-statement)
  153.   (define-key cobol-mode-map "\C-c\C-n" 'cobol-next-statement)
  154.   (define-key cobol-mode-map "\C-c\C-c" 'cobol-goto-column)
  155.   (define-key cobol-mode-map "\C-cc" 'cobol-goto-column) ; avoid confusion
  156.   (define-key cobol-mode-map "\C-c\C-l" 'goto-line) ; for Sam
  157.   (define-key cobol-mode-map "\C-cl" 'goto-line) ; avoid confusion
  158.   (define-key cobol-mode-map "\t" 'cobol-indent-line)
  159.   (define-key cobol-mode-map "\C-m" 'newline-and-indent) ; magic RET key
  160.   (let ((n ?\ ))
  161.     (while (< n 127)
  162.       (define-key cobol-mode-map (char-to-string n) 'cobol-self-insert)
  163.       (setq n (1+ n))))
  164.   (define-key cobol-mode-map "\177" 'cobol-back-delete) ; magic DEL key too
  165. ;  (define-key cobol-mode-map "0" 'cobol-electric-line-number)
  166. ;  (define-key cobol-mode-map "1" 'cobol-electric-line-number)
  167. ;  (define-key cobol-mode-map "2" 'cobol-electric-line-number)
  168. ;  (define-key cobol-mode-map "3" 'cobol-electric-line-number)
  169. ;  (define-key cobol-mode-map "4" 'cobol-electric-line-number)
  170. ;  (define-key cobol-mode-map "5" 'cobol-electric-line-number)
  171. ;  (define-key cobol-mode-map "6" 'cobol-electric-line-number)
  172. ;  (define-key cobol-mode-map "7" 'cobol-electric-line-number)
  173. ;  (define-key cobol-mode-map "8" 'cobol-electric-line-number)
  174. ;  (define-key cobol-mode-map "9" 'cobol-electric-line-number)
  175.   )
  176.  
  177. (defvar cobol-mode-abbrev-table nil)
  178. (if cobol-mode-abbrev-table
  179.     ()
  180.   (define-abbrev-table 'cobol-mode-abbrev-table ())
  181.   (let ((abbrevs-changed nil))
  182.     (define-abbrev cobol-mode-abbrev-table  ";b"   "byte" nil)
  183.     (define-abbrev cobol-mode-abbrev-table  ";ch"  "character" nil)
  184.     (define-abbrev cobol-mode-abbrev-table  ";cl"  "close" nil)
  185.     (define-abbrev cobol-mode-abbrev-table  ";c"   "continue" nil)
  186.     (define-abbrev cobol-mode-abbrev-table  ";cm"  "common" nil)
  187.     (define-abbrev cobol-mode-abbrev-table  ";cx"  "complex" nil)
  188.     (define-abbrev cobol-mode-abbrev-table  ";di"  "dimension" nil)
  189.     (define-abbrev cobol-mode-abbrev-table  ";do"  "double" nil)
  190.     (define-abbrev cobol-mode-abbrev-table  ";dc"  "double complex" nil)
  191.     (define-abbrev cobol-mode-abbrev-table  ";dp"  "double precision" nil)
  192.     (define-abbrev cobol-mode-abbrev-table  ";dw"  "do while" nil)
  193.     (define-abbrev cobol-mode-abbrev-table  ";e"   "else" nil)
  194.     (define-abbrev cobol-mode-abbrev-table  ";ed"  "enddo" nil)
  195.     (define-abbrev cobol-mode-abbrev-table  ";el"  "elseif" nil)
  196.     (define-abbrev cobol-mode-abbrev-table  ";en"  "endif" nil)
  197.     (define-abbrev cobol-mode-abbrev-table  ";eq"  "equivalence" nil)
  198.     (define-abbrev cobol-mode-abbrev-table  ";ex"  "external" nil)
  199.     (define-abbrev cobol-mode-abbrev-table  ";ey"  "entry" nil)
  200.     (define-abbrev cobol-mode-abbrev-table  ";f"   "format" nil)
  201.     (define-abbrev cobol-mode-abbrev-table  ";fu"  "function" nil)
  202.     (define-abbrev cobol-mode-abbrev-table  ";g"   "goto" nil)
  203.     (define-abbrev cobol-mode-abbrev-table  ";im"  "implicit" nil)
  204.     (define-abbrev cobol-mode-abbrev-table  ";ib"  "implicit byte" nil)
  205.     (define-abbrev cobol-mode-abbrev-table  ";ic"  "implicit complex" nil)
  206.     (define-abbrev cobol-mode-abbrev-table  ";ich" "implicit character" nil)
  207.     (define-abbrev cobol-mode-abbrev-table  ";ii"  "implicit integer" nil)
  208.     (define-abbrev cobol-mode-abbrev-table  ";il"  "implicit logical" nil)
  209.     (define-abbrev cobol-mode-abbrev-table  ";ir"  "implicit real" nil)
  210.     (define-abbrev cobol-mode-abbrev-table  ";inc" "include" nil)
  211.     (define-abbrev cobol-mode-abbrev-table  ";in"  "integer" nil)
  212.     (define-abbrev cobol-mode-abbrev-table  ";intr" "intrinsic" nil)
  213.     (define-abbrev cobol-mode-abbrev-table  ";l"   "logical" nil)
  214.     (define-abbrev cobol-mode-abbrev-table  ";op"  "open" nil)
  215.     (define-abbrev cobol-mode-abbrev-table  ";pa"  "parameter" nil)
  216.     (define-abbrev cobol-mode-abbrev-table  ";pr"  "program" nil)
  217.     (define-abbrev cobol-mode-abbrev-table  ";p"   "print" nil)
  218.     (define-abbrev cobol-mode-abbrev-table  ";re"  "real" nil)
  219.     (define-abbrev cobol-mode-abbrev-table  ";r"   "read" nil)
  220.     (define-abbrev cobol-mode-abbrev-table  ";rt"  "return" nil)
  221.     (define-abbrev cobol-mode-abbrev-table  ";rw"  "rewind" nil)
  222.     (define-abbrev cobol-mode-abbrev-table  ";s"   "stop" nil)
  223.     (define-abbrev cobol-mode-abbrev-table  ";su"  "subroutine" nil)
  224.     (define-abbrev cobol-mode-abbrev-table  ";ty"  "type" nil)
  225.     (define-abbrev cobol-mode-abbrev-table  ";w"   "write" nil)))
  226.  
  227. (defun cobol-mode ()
  228.   "Major mode for editing cobol code.
  229. Tab indents the current cobol line correctly. 
  230.  
  231. Type `;?' or `;\\[help-command]' to display a list of built-in abbrevs for Cobol keywords.
  232.  
  233. Variables controlling indentation style and extra features:
  234.  
  235.  comment-start
  236.     Should allways be nil in Cobol mode.  Cobol has no in-line comments.
  237.  cobol-do-indent
  238.     Extra indentation within do blocks.  (default 4)
  239.  cobol-if-indent
  240.     Extra indentation within if blocks.  (default 4)
  241.  cobol-continuation-indent
  242.     Extra indentation appled to continuation statements.  (default 6)
  243.  cobol-indent-increment
  244.     Amount of indentation to add to a line when it can be indented (default 4)
  245.  cobol-comment-line-column
  246.     Amount of indentation for text within full-line comments. (default 6)
  247.  cobol-comment-indent-style
  248.     nil    means don't change indentation of text in full-line comments,
  249.     fixed  means indent that text at column cobol-comment-line-column
  250.     relative  means indent at cobol-comment-line-column beyond the
  251.            indentation for a line of code.
  252.     Default value is fixed.
  253.  cobol-comment-indent-char
  254.     Character to be inserted instead of space for full-line comment
  255.     indentation.  (default SPC)
  256.  cobol-minimum-statement-indent
  257.     Minimum indentation for cobol statements. (default 8)
  258.  cobol-line-number-indent
  259.     Maximum indentation for line numbers.  A line number will get
  260.     less than this much indentation if necessary to avoid reaching
  261.     column 5.  (default 1)
  262.  cobol-check-all-num-for-matching-do
  263.     Non-nil causes all numbered lines to be treated as possible 'continue'
  264.     statements.  (default nil)
  265.  cobol-continuation-char
  266.     character to be inserted in column 5 of a continuation line.
  267.     (default is ?-)
  268.  cobol-comment-region
  269.     String inserted by \\[cobol-comment-region] at start of each line in 
  270.     region.  (default \"      ** \")
  271.  cobol-electric-line-number
  272.     Non-nil causes line number digits to be moved to the correct column 
  273.     as typed.  (default t)
  274.  cobol-startup-message
  275.     Set to nil to inhibit message first time cobol-mode is used.
  276.  
  277. Turning on Cobol mode calls the value of the variable cobol-mode-hook 
  278. with no args, if that value is non-nil.
  279. \\{cobol-mode-map}"
  280.   (interactive)
  281.   (kill-all-local-variables)
  282.   (if cobol-startup-message
  283.       (message "Emacs Cobol mode ver. %s.  Mail bugs to bug-cobol-mode@cis.ohio-state.edu" cobol-mode-version))
  284.   (setq cobol-startup-message nil)
  285. ;;  (setq local-abbrev-table cobol-mode-abbrev-table)  ;; no abbrevs for now
  286.   (set-syntax-table cobol-mode-syntax-table)
  287.   (make-local-variable 'indent-line-function)
  288.   (setq indent-line-function 'cobol-indent-line)
  289.   (make-local-variable 'comment-indent-hook)
  290.   (setq comment-indent-hook 'cobol-comment-hook)
  291.   (make-local-variable 'comment-line-start-skip)
  292.   (setq comment-line-start-skip "^ *\\*") ; The only way to do a comment is a * in column 7
  293.   (make-local-variable 'comment-line-start)
  294.   (setq comment-line-start "** ")
  295.   (make-local-variable 'comment-start-skip)
  296.   (setq comment-start-skip "![ \t]*")
  297.   (make-local-variable 'comment-start)
  298.   (setq comment-start nil)        ; COBOL has no in-line comments
  299.   (make-local-variable 'comment-column)
  300.   (setq comment-column cobol-comment-line-column)
  301.   (make-local-variable 'require-final-newline)
  302.   (setq require-final-newline t)
  303.   (make-local-variable 'write-file-hooks)
  304.   (setq write-file-hooks (cons 'cobol-no-tabs-hook write-file-hooks))
  305.   (make-local-variable 'find-file-hooks)
  306.   (setq find-file-hooks (cons 'cobol-no-tabs-hook find-file-hooks))
  307.   (make-local-variable 'abbrev-all-caps)
  308.   (setq abbrev-all-caps t)
  309.   (make-local-variable 'indent-tabs-mode)
  310.   (setq indent-tabs-mode nil)
  311.   (make-local-variable 'fill-column)
  312.   (setq fill-column 70)
  313.   (use-local-map cobol-mode-map)
  314.   (setq mode-name "Cobol")
  315.   (setq major-mode 'cobol-mode)
  316.   (run-hooks 'cobol-mode-hook))
  317.  
  318. (defun cobol-comment-hook ()
  319.   cobol-comment-line-column)        ; ALLWAYS comment in the comment column
  320.  
  321. (defun cobol-self-insert (arg)
  322.   "Do a self-insert-command, and check for the right margin, ringing
  323. the bell if it is reached."
  324.   (interactive "*p")
  325.   (let ((column (current-column)))
  326.     (self-insert-command arg)
  327.     (if (and (< column fill-column)
  328.          (>= (current-column)
  329.          fill-column))
  330.     (beep 't))))
  331.  
  332. (defun cobol-goto-column (arg)
  333.   "Goto column ARG, counting from column 1, adding spaces to
  334.  the end of the line if needed"
  335.   (interactive "NGoto column: ")
  336.   (if (> arg 0)
  337.       (progn
  338.     (end-of-line)
  339.     (if (> (current-column) (- arg 1))
  340.         (progn
  341.           (beginning-of-line)
  342.           (forward-char (- arg 1)))
  343.       (insert-char ?  (- arg (current-column) 1))))))
  344.     
  345. (defun cobol-back-delete (arg &optional killp)
  346.   "Slightly magic version of backward-delete-char-untabify"
  347.   (interactive "*p\nP")
  348.   (let (atws (column (current-column)))
  349.     (insert-char ?\n 1)
  350.     (forward-char -1)
  351.     (beginning-of-line)
  352.     (if (looking-at "[ \t]*$")
  353.     (progn
  354.       (if (= (% (+ column 1) cobol-indent-increment) 0)
  355.           (setq column (max cobol-minimum-statement-indent
  356.                 (- column cobol-indent-increment)))
  357.         (setq column (max cobol-minimum-statement-indent
  358.                   (* (/ column cobol-indent-increment)
  359.                  cobol-indent-increment))))
  360.       (delete-horizontal-space)
  361.       (insert-char (if (stringp cobol-comment-indent-char)
  362.                (aref cobol-comment-indent-char 0)
  363.              cobol-comment-indent-char)
  364.                column))
  365.       (progn
  366.     (end-of-line)
  367.     (backward-delete-char-untabify arg killp)))
  368.     (end-of-line)
  369.     (delete-char 1)))
  370.  
  371. (defun cobol-no-tabs-hook ()
  372.   "Hook for write file that removes all tabs from the buffer.
  373. This function must return nil so that the file will actually be written."
  374.   (save-excursion
  375.     ; the following code is stolen from tabify.el...
  376.     (goto-char (point-min))
  377.     (while (search-forward "\t" nil t)        ; faster than re-search
  378.       (let ((start (point))
  379.         (column (current-column))
  380.         (indent-tabs-mode nil))
  381.     (skip-chars-backward "\t")
  382.     (delete-region start (point))
  383.     (indent-to column))))
  384.   nil)                ; just in case to make sure file is written
  385.  
  386. (defun cobol-indent-comment ()
  387.   "Align or create comment on current line.
  388. Existing comments of all types are recognized and aligned.
  389. If the line has no comment, a side-by-side comment is inserted and aligned
  390. if the value of  comment-start  is not nil.
  391. Otherwise, a separate-line comment is inserted, on this line
  392. or on a new line inserted before this line if this line is not blank."
  393.   (interactive)
  394.   (beginning-of-line)
  395.   ;; Recognize existing comments of either kind.
  396.   (cond ((looking-at comment-line-start-skip)
  397.      (delete-horizontal-regexp " \t\\*") ; kill the old comment stuff
  398.      (indent-to (cobol-comment-hook))
  399.      (insert comment-line-start))
  400.     ;; No existing comment.
  401.     ;; Insert separate-line comment, making a new line if nec.
  402.     (t
  403.      (if (looking-at "^[ \t]*$")
  404.          (delete-horizontal-space)
  405.        (beginning-of-line)
  406.        (insert "\n")
  407.        (forward-char -1))
  408.      (indent-to (cobol-comment-hook))
  409.      (insert comment-line-start)
  410.      )))
  411.  
  412. ;;     (insert-char (if (stringp cobol-comment-indent-char)
  413. ;;              (aref cobol-comment-indent-char 0)
  414. ;;              cobol-comment-indent-char)
  415. ;;              (- (calculate-cobol-indent) (current-column))))))
  416.  
  417. (defun cobol-comment-region (beg-region end-region arg)
  418.   "Comments every line in the region.
  419. Puts cobol-comment-region at the beginning of every line in the region. 
  420. BEG-REGION and END-REGION are args which specify the region boundaries. 
  421. With non-nil ARG, uncomments the region."
  422.   (interactive "*r\nP")
  423.   (let ((end-region-mark (make-marker)) (save-point (point-marker)))
  424.     (set-marker end-region-mark end-region)
  425.     (goto-char beg-region)
  426.     (beginning-of-line)
  427.     (if (not arg)            ;comment the region
  428.     (progn (insert cobol-comment-region)
  429.            (while (and  (= (forward-line 1) 0)
  430.                 (< (point) end-region-mark))
  431.          (insert cobol-comment-region)))
  432.       (let ((com (regexp-quote cobol-comment-region))) ;uncomment the region
  433.     (if (looking-at com)
  434.         (delete-region (point) (match-end 0)))
  435.     (while (and  (= (forward-line 1) 0)
  436.              (< (point) end-region-mark))
  437.       (if (looking-at com)
  438.           (delete-region (point) (match-end 0))))))
  439.     (goto-char save-point)
  440.     (set-marker end-region-mark nil)
  441.     (set-marker save-point nil)))
  442.  
  443. (defun cobol-abbrev-start ()
  444.   "Typing \";\\[help-command]\" or \";?\" lists all the cobol abbrevs. 
  445. Any other key combination is executed normally." ;\\[help-command] is just a way to print the value of the variable help-char.
  446.   (interactive)
  447.   (let (c)
  448.     (insert last-command-char)
  449.     (if (or (= (setq c (read-char)) ??)    ;insert char if not equal to `?'
  450.         (= c help-char))
  451.     (cobol-abbrev-help)
  452.       (setq unread-command-char c))))
  453.  
  454. (defun cobol-abbrev-help ()
  455.   "List the currently defined abbrevs in Cobol mode."
  456.   (interactive)
  457.   (message "Listing abbrev table...")
  458.   (require 'abbrevlist)
  459.   (list-one-abbrev-table cobol-mode-abbrev-table "*Help*")
  460.   (message "Listing abbrev table...done"))
  461.  
  462. (defun cobol-column-ruler ()
  463.   "Inserts a column ruler momentarily above current line, till next keystroke.
  464. The ruler is defined by the value of cobol-column-ruler.
  465. The key typed is executed unless it is SPC."
  466.   (interactive)
  467.   (momentary-string-display 
  468.    cobol-column-ruler (save-excursion (beginning-of-line) (point))
  469.    nil "Type SPC or any command to erase ruler."))
  470.  
  471. (defun cobol-window-create ()
  472.   "Makes the window 72 columns wide."
  473.   (interactive)
  474.   (let ((window-min-width 2))
  475.     (split-window-horizontally 73))
  476.   (other-window 1)
  477.   (switch-to-buffer " cobol-window-extra" t)
  478.   (select-window (previous-window)))
  479.  
  480. (defun cobol-split-line ()
  481.   "Break line at point and insert continuation marker and alignment."
  482.   (interactive)
  483.   (delete-horizontal-space)
  484.   (if (save-excursion (beginning-of-line) (looking-at comment-line-start-skip))
  485.       (insert ?\n comment-line-start ?\  )
  486.       (insert ?\n cobol-continuation-char))
  487.   (cobol-indent-line))
  488.  
  489. (defun delete-horizontal-regexp (chars)
  490.   "Delete all characters in CHARS around point.
  491. CHARS is like the inside of a [...] in a regular expression
  492. except that ] is never special and \ quotes ^, - or \."
  493.   (interactive "*s")
  494.   (skip-chars-backward chars)
  495.   (delete-region (point) (progn (skip-chars-forward chars) (point))))
  496.  
  497. (defun cobol-electric-line-number (arg)
  498.   "Self insert, but if part of a Cobol line number indent it automatically.
  499. Auto-indent does not happen if a numeric arg is used."
  500.   (interactive "P")
  501.   (if (or arg (not cobol-electric-line-number))
  502.       (self-insert-command arg)
  503.     (if (or (save-excursion (re-search-backward "[^ \t0-9]"
  504.                         (save-excursion
  505.                           (beginning-of-line)
  506.                           (point))
  507.                         t)) ;not a line number
  508.         (looking-at "[0-9]"))        ;within a line number
  509.     (insert last-command-char)
  510.       (skip-chars-backward " \t")
  511.       (insert last-command-char)
  512.       (cobol-indent-line))))
  513.  
  514. (defun beginning-of-cobol-subprogram ()
  515.   "Moves point to the beginning of the current cobol subprogram."
  516.   (interactive)
  517.   (let ((case-fold-search t))
  518.     (beginning-of-line -1)
  519.     (re-search-backward "^[ \t0-9]*end\\b[ \t]*[^ \t=(a-z]" nil 'move)
  520.     (if (looking-at "^[ \t0-9]*end\\b[ \t]*[^ \t=(a-z]")
  521.     (forward-line 1))))
  522.  
  523. (defun end-of-cobol-subprogram ()
  524.   "Moves point to the end of the current cobol subprogram."
  525.   (interactive)
  526.   (let ((case-fold-search t))
  527.     (beginning-of-line 2)
  528.     (re-search-forward "^[ \t0-9]*end\\b[ \t]*[^ \t=(a-z]" nil 'move)
  529.     (goto-char (match-beginning 0))
  530.     (forward-line 1)))
  531.  
  532. (defun mark-cobol-subprogram ()
  533.   "Put mark at end of cobol subprogram, point at beginning. 
  534. The marks are pushed."
  535.   (interactive)
  536.   (end-of-cobol-subprogram)
  537.   (push-mark (point))
  538.   (beginning-of-cobol-subprogram))
  539.   
  540. (defun cobol-previous-statement ()
  541.   "Moves point to beginning of the previous cobol statement.
  542. Returns 'first-statement if that statement is the first
  543. non-comment Cobol statement in the file, and nil otherwise."
  544.   (interactive)
  545.   (let (not-first-statement continue-test)
  546.     (beginning-of-line)
  547.     (setq continue-test
  548.       (looking-at
  549.        (concat "      " (regexp-quote (char-to-string
  550.                        cobol-continuation-char)))))
  551.     (while (and (setq not-first-statement (= (forward-line -1) 0))
  552. ;;        (or (looking-at comment-line-start-skip))
  553.         (looking-at "[ \t]*$")))
  554.     (cond ((and continue-test
  555.         (not not-first-statement))
  556.        (message "Incomplete continuation statement."))
  557.       (continue-test    
  558.        (cobol-previous-statement))
  559.       ((not not-first-statement)
  560.        'first-statement))))
  561.  
  562. (defun cobol-next-statement ()
  563.   "Moves point to beginning of the next cobol statement.
  564.  Returns 'last-statement if that statement is the last
  565.  non-comment Cobol statement in the file, and nil otherwise."
  566.   (interactive)
  567.   (let (not-last-statement)
  568.     (beginning-of-line)
  569.     (while (and (setq not-last-statement (= (forward-line 1) 0))
  570.          (or (looking-at comment-line-start-skip)
  571.              (looking-at "[ \t]*$")
  572.             )))
  573.     (if (not not-last-statement)
  574.      'last-statement)))
  575.  
  576. (defun cobol-indent-line ()
  577.   "Indents current cobol line based on its contents and on previous lines."
  578.   (interactive)
  579.   (if (or (eq last-command 'cobol-indent-line) ; if we just did a tab
  580.       (let (atws)
  581.         (insert-char ?\n 1)
  582.         (forward-char -1)
  583.         (beginning-of-line)
  584.         (setq atws (looking-at "[ \t]*$"))
  585.         (end-of-line)
  586.         (delete-char 1)
  587.         (not atws)))
  588.       (insert-char (if (stringp cobol-comment-indent-char)
  589.                (aref cobol-comment-indent-char 0)
  590.              cobol-comment-indent-char)
  591.            (- cobol-indent-increment
  592.               (% (+ (current-column) 1) cobol-indent-increment)))
  593.     
  594.     (let ((do-another-tab nil)
  595.       (cfi (calculate-cobol-indent))
  596.       (cur-col (current-column))) ; we did NOT just do a tab
  597.       (save-excursion
  598.     (beginning-of-line)
  599.     (if (not (= cfi (current-indentation)))
  600.         (cobol-indent-to-column cfi)
  601.       ; else the line is indented correctly; check for a comment
  602.       (beginning-of-line)
  603.       (if (re-search-forward comment-start-skip
  604.                  (save-excursion (end-of-line) (point)) 'move)
  605.           (cobol-indent-comment)
  606.         ; else not looking at a comment; make another tab
  607.         (if (= cur-col cfi)
  608.         (setq do-another-tab 't)))))
  609.       (if do-another-tab
  610.       (insert-char (if (stringp cobol-comment-indent-char)
  611.                (aref cobol-comment-indent-char 0)
  612.              cobol-comment-indent-char)
  613.                (- cobol-indent-increment
  614.               (% (+ (current-column) 1)
  615.                  cobol-indent-increment))))
  616.       ;; Never leave point in left margin.
  617.       (if (< (current-column) cfi)
  618.       (move-to-column cfi)))))
  619.  
  620. (defun cobol-indent-subprogram ()
  621.   "Properly indents the Cobol subprogram which contains point."
  622.   (interactive)
  623.   (save-excursion
  624.     (mark-cobol-subprogram)
  625.     (message "Indenting subprogram...")
  626.     (indent-region (point) (mark) nil))
  627.   (message "Indenting subprogram...done."))
  628.  
  629. (defun calculate-cobol-indent ()
  630.   "Calculates the cobol indent column based on previous lines."
  631.   (let (icol first-statement (special-col nil) (case-fold-search t))
  632.     (save-excursion
  633.       (setq first-statement (cobol-previous-statement))
  634.       (if first-statement
  635.       (setq icol cobol-minimum-statement-indent)
  636.     (progn
  637.       (if (= (point) (point-min))
  638.           (setq icol cobol-minimum-statement-indent)
  639.         (setq icol (cobol-current-line-indentation)))
  640.       (if (looking-at "[ \t]*\\*")    ; if looking a at comment
  641.           (setq special-col 't))
  642.       (skip-chars-forward " \t0-9")
  643.       (cond ((looking-at "if[ \t]*(")
  644.          (if (or (looking-at ".*)[ \t]*then\\b[ \t]*[^ \t(=a-z0-9]")
  645.              (let (then-test)    ;multi-line if-then
  646.                (while (and (= (forward-line 1) 0) ;search forward for then
  647.                        (looking-at "     [^ 0]")
  648.                        (not (setq then-test (looking-at ".*then\\b[ \t]*[^ \t(=a-z0-9]")))))
  649.                then-test))
  650.              (setq icol (+ icol cobol-if-indent))))
  651.         ((looking-at "\\(else\\|elseif\\)\\b")
  652.          (setq icol (+ icol cobol-if-indent)))
  653.         ((looking-at "do\\b")
  654.          (setq icol (+ icol cobol-do-indent)))))))
  655.     (save-excursion
  656.       (beginning-of-line)
  657.       (cond ((looking-at "[ \t]*$"))    ; blank lines do nothing
  658.         ((looking-at comment-line-start-skip) ; junk for comments
  659.          (setq icol cobol-comment-line-column)
  660.          (setq special-col t))
  661.         ((looking-at (concat "      "
  662.                  (regexp-quote (char-to-string cobol-continuation-char))))
  663.          (setq icol cobol-continuation-indent)
  664.          (setq special-col t))
  665.         (first-statement)        ;if first in the file, don't do anything
  666.         ((and cobol-check-all-num-for-matching-do
  667.           (looking-at "[ \t]*[0-9]+")
  668.           (cobol-check-for-matching-do))
  669.          (setq icol (- icol cobol-do-indent)))
  670.         (t
  671.          (skip-chars-forward " \t")    ; skip to first real stuff
  672.          (cond
  673.           ;;; The following are for special names that MUST
  674.           ;;; start in area A (column 8-11)
  675.           ((looking-at "[a-z]+ +division") ; divisions in area A
  676.            (setq icol cobol-minimum-statement-indent))
  677.           ((looking-at "[a-z]+ +section") ; sections in area A
  678.            (setq icol cobol-minimum-statement-indent))
  679.           ;; this SHOULD get paragraph names
  680.           ((looking-at "[a-z]+\\.") ; paragraphs
  681.            (setq icol cobol-minimum-statement-indent))
  682.           ((looking-at "fd ")    ; fd's in area A
  683.            (setq icol cobol-minimum-statement-indent))
  684.           ((looking-at "sd ")    ; sd's in area A
  685.            (setq icol cobol-minimum-statement-indent))
  686.           ((looking-at "rd ")    ; rd's in area A
  687.            (setq icol cobol-minimum-statement-indent))
  688.           ((looking-at "cd ")    ; cd's in area A
  689.            (setq icol cobol-minimum-statement-indent))
  690.           ((looking-at "01 ")    ; 01 level numbers in A too
  691.            (setq icol cobol-minimum-statement-indent))
  692.           ((looking-at "77 ")    ; and 77 level numbers
  693.            (setq icol cobol-minimum-statement-indent))
  694.  
  695.           ;;; the following are for end-of-block detection
  696.           ((looking-at "end-if\\b")
  697.            (setq icol (- icol cobol-if-indent)))
  698.           ((looking-at "else\\b")
  699.            (setq icol (- icol cobol-if-indent)))
  700.           ((and (looking-at "continue\\b")
  701.             (cobol-check-for-matching-do))
  702.            (setq icol (- icol cobol-do-indent)))
  703.           ((looking-at "end[ \t]*do\\b")
  704.            (setq icol (- icol cobol-do-indent)))
  705.           ((and (looking-at "end\\b[ \t]*[^ \t=(a-z]")
  706.             (not (= icol cobol-minimum-statement-indent)))
  707.            (message "Warning: `end' not in column %d.  Probably an unclosed block." cobol-minimum-statement-indent))
  708.           (t            ; in the case of normal lines
  709.            nil)
  710.            ))))
  711.     (if special-col
  712.     icol
  713.       (max cobol-minimum-statement-indent icol))))
  714.  
  715. (defun cobol-current-line-indentation ()
  716.   "Indentation of current line, ignoring Cobol line number or continuation.
  717. This is the column position of the first non-whitespace character
  718. aside from the line number and/or column 5 line-continuation character.
  719. For comment lines, returns indentation of the first
  720. non-indentation text within the comment."
  721.   (current-indentation))
  722. ;  (save-excursion
  723. ;    (beginning-of-line)
  724. ;    (cond ((looking-at comment-line-start-skip)
  725. ;       (goto-char (match-end 0))
  726. ;       (skip-chars-forward
  727. ;         (if (stringp cobol-comment-indent-char)
  728. ;         cobol-comment-indent-char
  729. ;             (char-to-string cobol-comment-indent-char))))
  730. ;      ((looking-at "     [^ 0\n]")
  731. ;       (goto-char (match-end 0)))
  732. ;      (t
  733. ;       ;; Move past line number.
  734. ;       (move-to-column 5)))
  735. ;    ;; Move past whitespace.
  736. ;    (skip-chars-forward " \t")
  737. ;    (current-column)))
  738.  
  739. (defun cobol-indent-to-column (col)
  740.   "Indents current line with spaces to column COL.
  741. notes: 1) A minus sign character in column 6 indicates a continuation
  742.           line, and this continuation character is retained on indentation;
  743.        2) If cobol-continuation-char is the first non-whitespace character,
  744.           this is a continuation line;
  745.        3) A non-continuation line which has a number as the first
  746.           non-whitespace character is a numbered line."
  747.   (save-excursion
  748.     (beginning-of-line)
  749.     (if (looking-at comment-line-start-skip)
  750.     (if cobol-comment-indent-style
  751.         (let ((char (if (stringp cobol-comment-indent-char)
  752.                 (aref cobol-comment-indent-char 0)
  753.                 cobol-comment-indent-char)))
  754.           (delete-horizontal-space)
  755.           (insert-char char cobol-comment-line-column)))
  756.  
  757. ;;      (if (looking-at "     [^ 0\n]")
  758. ;;      (forward-char 8)
  759. ;;    (delete-horizontal-space)
  760. ;;    ;; Put line number in columns 0-4
  761. ;;    ;; or put continuation character in column 5.
  762. ;;    (cond ((eobp))
  763. ;;          ((= (following-char) cobol-continuation-char)
  764. ;;           (indent-to 5)
  765. ;;           (forward-char 1))
  766. ;;          ((looking-at "[0-9]+")
  767. ;;           (let ((extra-space (- 5 (- (match-end 0) (point)))))
  768. ;;         (if (< extra-space 0)
  769. ;;             (message "Warning: line number exceeds 5-digit limit.")
  770. ;;           (indent-to (min cobol-line-number-indent extra-space))))
  771. ;;           (skip-chars-forward "0-9"))))
  772.       ;; Point is now after any continuation character or line number.
  773.       ;; Put body of statement where specified.
  774.       (delete-horizontal-space)
  775.       (indent-to col)
  776.       ;; Indent any comment following code on the same line.
  777. ;;      (if (re-search-forward comment-start-skip
  778. ;;                 (save-excursion (end-of-line) (point)) t)
  779. ;;      (progn (goto-char (match-beginning 0))
  780. ;;         (if (not (= (current-column) (cobol-comment-hook)))
  781. ;;             (progn (delete-horizontal-space)
  782. ;;                (indent-to (cobol-comment-hook))))))
  783.       )))
  784.  
  785. (defun cobol-line-number-indented-correctly-p ()
  786.   "Return t if current line's line number is correctly indente.
  787. Do not call if there is no line number."
  788.   (save-excursion
  789.     (beginning-of-line)
  790.     (skip-chars-forward " \t")
  791.     (and (<= (current-column) cobol-line-number-indent)
  792.      (or (= (current-column) cobol-line-number-indent)
  793.          (progn (skip-chars-forward "0-9")
  794.             (= (current-column) 5))))))
  795.  
  796. (defun cobol-check-for-matching-do ()
  797.   "When called from a numbered statement, returns t
  798.  if matching 'do' is found, and nil otherwise."
  799.   (let (charnum
  800.     (case-fold-search t))
  801.     (save-excursion
  802.       (beginning-of-line)
  803.       (if (looking-at "[ \t]*[0-9]+")
  804.       (progn
  805.         (skip-chars-forward " \t")
  806.         (skip-chars-forward "0") ;skip past leading zeros
  807.         (setq charnum (buffer-substring (point)
  808.                         (progn (skip-chars-forward "0-9")
  809.                            (point))))
  810.         (beginning-of-line)
  811.         (and (re-search-backward
  812.           (concat "\\(^[ \t0-9]*end\\b[ \t]*[^ \t=(a-z]\\)\\|\\(^[ \t0-9]*do[ \t]*0*"
  813.               charnum "\\b\\)\\|\\(^[ \t]*0*" charnum "\\b\\)")
  814.           nil t)
  815.          (looking-at (concat "^[ \t0-9]*do[ \t]*0*" charnum))))))))
  816.  
  817.  
  818.