PageRenderTime 31ms CodeModel.GetById 18ms RepoModel.GetById 1ms app.codeStats 0ms

/old-archive/modes/cobol.el

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