PageRenderTime 65ms CodeModel.GetById 22ms RepoModel.GetById 1ms app.codeStats 0ms

/nmcobol-mode.el

https://github.com/emacsmirror/nmcobol-mode
Emacs Lisp | 2162 lines | 1677 code | 166 blank | 319 comment | 78 complexity | 794f099dbe49df543a16b2714595bad2 MD5 | raw file
    

  1. ;;; nmcobol-mode.el --- For use with Tandem Cobol only - Sorry.
    2. 

  2. 

  3. ;; Copyright (C) 2006, 2007 Free Software Foundation, Inc.
    4. 

  4. 

  5. ;; Author: Rick Bielawski <rbielaws@i1.net>
    6. 

  6. ;; Keywords: languages, COBOL, Tandem, Guardian, NSK
    7. 

  7. ;; Maintainer: Rick Bielawski <rbielaws@i1.net>
    8. 

  8. 

  9. ;; This file is free software; you can redistribute it and/or modify
    10. 

  10. ;; it under the terms of the GNU General Public License as published by
    11. 

  11. ;; the Free Software Foundation; either version 2, or (at your option)
    12. 

  12. ;; any later version.
    13. 

  13. 

  14. ;; This file is distributed in the hope that it will be useful,
    15. 

  15. ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
    16. 

  16. ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
    17. 

  17. ;; GNU General Public License for more details.
    18. 

  18. 

  19. ;; You should have received a copy of the GNU General Public License
    20. 

  20. ;; along with GNU Emacs; see the file COPYING.  If not, write to the
    21. 

  21. ;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
    22. 

  22. ;; Boston, MA 02110-1301, USA.
    23. 

  23. 

  24. ;;; Commentary:
    25. 

  25. 

  26. ;; NMCOBOL -- COmmon Business Oriented Language - in ?TANDEM line format.
    27. 

  27. 

  28. ;; This is currently a work-in-progress.  You are welcome to try it and
    29. 

  29. ;; submit changes or report bugs but there is no point trying to report
    30. 

  30. ;; lack of features unless you are including patches that address such
    31. 

  31. ;; shortcomings.
    32. 

  32. ;;
    33. 

  33. ;; Since Tandem's line format is not standard this mode is not likely to
    34. 

  34. ;; suit the needs of most Cobol progammers.  Moreover, Tandem Cobol has
    35. 

  35. ;; extensions that standard Cobol doesn't have and may not implement
    36. 

  36. ;; features required or generally available by other Cobol compilers.
    37. 

  37. ;; I'm happy to add submitted patches to support other compilers only if
    38. 

  38. ;; such patches don't interfere with support of Tandem Cobol.
    39. 

    40. 

  40. ;;; Installing:
    41. 

  41. 

  42. ;; Before you can use nmcobol-mode, emacs needs to be able to find it.  Place
    43. 

  43. ;; the nmcobol-mode.el file in a directory on the load-path; typically the
    44. 

  44. ;; .../site-lisp or perhaps .../lisp/progmods directory.  Usually you would
    45. 

  45. ;; also want to byte compile nmcobol-mode.el but this is not required.  To do
    46. 

  46. ;; this, visit the nmcobol-mode.el file, type: M-x emacs-lisp-byte-compile <ret>
    47. 

  47. ;; There should be no warnings or errors during byte compilation.
    48. 

  48. ;;
    49. 

  49. ;; There are 4 basic ways to use NMCOBOL-MODE on a file.  The first method
    50. 

  50. ;; manually selects nmcobol-mode as the editing mode.  The other 3 cause emacs
    51. 

  51. ;; to recognize automatically that you want to visit the file using
    52. 

  52. ;; nmcobol-mode.
    53. 

  53. ;;
    54. 

  54. ;; Pick one:
    55. 

  55. ;; 1. While visiting a file, type: M-x nmcobol-mode <ret>
    56. 

  56. ;; 2. Put the string -*-nmcobol-*- in a comment on the first line of the file.
    57. 

  57. ;;    Save the file and close it.  Now any time you open it nmcobol-mode starts.
    58. 

  58. ;; 3. Create an association between a particular file naming convention and
    59. 

  59. ;;    nmcobol-mode.  This is done by adding an association to auto-mode-alist.
    60. 

  60. ;; For example:
    61. 

  61. ;; (setq auto-mode-alist
    62. 

  62. ;;   (append
    63. 

  63. ;;     '(("\\.cob\\'" . nmcobol-mode)      ;extension of .cob means nmcobol-mode
    64. 

  64. ;;       ("\\([\\/]\\|^\\)[^.]+$" . nmcobol-mode)) ;so does no extension at all.
    65. 

  65. ;;    auto-mode-alist))
    66. 

  66. ;; 4. Advise set-auto-mode to look at the buffer contents upon loading.
    67. 

  67. ;;    For an example see: http://www.emacswiki.org/cgi-bin/wiki/TandemNskSupport
    68. 

  68. ;;
    69. 

  69. ;; The above all tell emacs that you want to use nmcobol-mode but you must load
    70. 

  70. ;; nmcobol-mode before you can use it.  There are 2 methods of telling emacs to
    71. 

  71. ;; load the nmcobol-mode routines.  The first unconditionally loads nmcobol-mode
    72. 

  72. ;; definitions immediately.  The second tells emacs to automatically load
    73. 

  73. ;; nmcobol-mode only when you try to use it.  Add one of the following lines to
    74. 

  74. ;; your .emacs file.
    75. 

  75. ;;
    76. 

  76. ;;(require 'nmcobol-mode)      ; Unconditional load
    77. 

  77. ;;(autoload 'nmcobol-mode "nmcobol-mode" "Major mode for Tandem NMCOBOL files." t nil)
    78. 

  78. ;;
    79. 

  79. ;;; Getting eldoc to work in nmcobol-mode:
    80. 

  80. 

  81. ;; Open a file containing variable declarations for which you want
    82. 

  82. ;; help permanently loaded.  For example: $SYSTEM.COPYLIBS.COBOLLIB.
    83. 

  83. ;; The buffer must be in nmcobol-mode or ddl-mode.
    84. 

  84. ;; Use:  M-x nmcobol-mode <ret> if necessary.
    85. 

  85. ;; Then: M-x nmcobol-eldoc-make-list <ret>
    86. 

  86. ;; You should now be in a specially formatted buffer containing a list of
    87. 

  87. ;; the variables declared and their corresponding help strings.  You can
    88. 

  88. ;; modify the strings themselves if desired but do not alter anything
    89. 

  89. ;; else.  Repeat these steps to add more help entries to the file.
    90. 

  90. ;; Save the file somewhere on your search list like your site-lisp
    91. 

  91. ;; directory. Example:
    92. 

  92. ;;     C-x C-w ~/../site-lisp/extdecs-help.el <ret>
    93. 

  93. ;; Now add the file you just saved to the list of nmcobol-mode eldoc help
    94. 

  94. ;; files to be loaded.
    95. 

  95. ;;     M-x customize-option <ret> nmcobol-eldoc-def-files <ret>
    96. 

  96. ;; Save the customization for future sessions.
    97. 

  97. ;; Once you have your help entries defined see help for eldoc-mode for
    98. 

  98. ;; turing on the mode.  Putting (eldoc-mode t) in .emacs might do it.
    99. 

  99. 

  100. ;;; History:
    101. 

  101. 

  102. ;; 2006-11-07 RGB Started writing this mode using my cobol-mode as skeleton.
    103. 

  103. ;; 2006-12-18 RGB Added eldoc support.
    104. 

  104. ;; 2006-12-26 RGB Added nmcobol-addup-pics.
    105. 

  105. ;; 2006-12-27 RGB Added thing-at-point support for Guardian style 'filename.
    106. 

  106. ;; 2006-12-29 RGB Added an NMCobol menu and nmcobol-customize-options.
    107. 

  107. ;; 2007-01-03 RGB Added movement by sentences.
    108. 

  108. ;; 2007-01-04 RGB Fixed movement by sentences, added paragraphs.
    109. 

  109. ;; 2007-01-04 RGB Make COUNT argument in movement by functions optional.
    110. 

  110. ;; 2007-01-09 RGB Added eldoc for variables including a buffer-local obarray.
    111. 

  111. ;; 2007-01-10 RGB Added Cobol specific support for anchored-transpose.
    112. 

  112. ;; 2007-01-11 RGB Fixed 66 level handling in paragraph movement and eldoc-scan.
    113. 

  113. ;; 2007-01-28 RGB Sentence/Paragraph movement now saves match data.
    114. 

  114. ;; 2007-01-31 RGB Started adding automatic indentation.
    115. 

  115. ;; 2007-02-01 RGB Made * electric.
    116. 

  116. ;; 2007-02-05 RGB Auto-indent now operates on regions
    117. 

  117. ;; 2007-02-07 RGB Fixed customization of nmcobol-keywords-case &
    118. 

  118. ;;                nmcobol-imenu-menubar. Fixed nmcobol-pic-string-regexp
    119. 

  119. ;;                not recognizing 'ZZZ-.' syntax.  Fixed
    120. 

  120. ;;                nmcobol-char-maybe-comment which broke numeric
    121. 

  121. ;;                prefix behavior.  Doc-string updates.
    122. 

  122. ;; 2007-02-12 RGB Indentation now handles all the block statements properly.
    123. 

  123. ;; 2007-02-13 RGB The beginning of secondary indentation started.  This
    124. 

  124. ;;                handles alignment of things like picture clauses, TO
    125. 

  125. ;;                statements etc.
    126. 

  126. ;; 2007-02-19 RGB imenu now ignores xxxx-exit paragraphs.  Started trying
    127. 

  127. ;;                to implement paren matching on end-<verb> keywords.
    128. 

  128. ;; 2007-02-22 RGB nmcobol-get-block-type now ignores keywords in strings.
    129. 

  129. ;;; Code:
    130. 

  130. 

  131. (defgroup nmcobol nil
    132. 

  132.   "Major mode for editing NMCOBOL source files in Emacs.
    133. 

  133. While in nmcobol-mode use C-h m for a description of the mode's features."
    134. 

  134.   :prefix 'nmcobol-
    135. 

  135.   :group 'languages)
    136. 

    137. 

  137. ;;; SYNTAX TABLE
    138. 

  138. 

  139. (defvar nmcobol-mode-syntax-table
    140. 

  140.   (let ((st (make-syntax-table)))
    141. 

  141.     (modify-syntax-entry ?\n " " st)
    142. 

  142.     (modify-syntax-entry ?\! "." st)
    143. 

  143.     (modify-syntax-entry ?\" "." st)  ; wiki ?" bug workaround comment
    144. 

  144.     (modify-syntax-entry ?\# "w" st)
    145. 

  145.     (modify-syntax-entry ?\$ "w" st)
    146. 

  146.     (modify-syntax-entry ?\% "'" st)
    147. 

  147.     (modify-syntax-entry ?\& "'" st)
    148. 

  148.     (modify-syntax-entry ?\' "." st)
    149. 

  149.     (modify-syntax-entry ?\( "()" st)
    150. 

  150.     (modify-syntax-entry ?\) ")(" st)
    151. 

  151.     (modify-syntax-entry ?\* "." st)
    152. 

  152.     (modify-syntax-entry ?\+ "." st)
    153. 

  153.     (modify-syntax-entry ?\, "." st)
    154. 

  154.     (modify-syntax-entry ?\- "w" st)
    155. 

  155.     (modify-syntax-entry ?\. "." st)
    156. 

  156.     (modify-syntax-entry ?\/ "." st)
    157. 

  157.     (modify-syntax-entry ?\: "." st)
    158. 

  158.     (modify-syntax-entry ?\; "." st)
    159. 

  159.     (modify-syntax-entry ?\< "." st)
    160. 

  160.     (modify-syntax-entry ?\= "." st)
    161. 

  161.     (modify-syntax-entry ?\> "." st)
    162. 

  162.     (modify-syntax-entry ?\? "." st)
    163. 

  163.     (modify-syntax-entry ?\@ "." st)
    164. 

  164.     (modify-syntax-entry ?\[ "(]" st)
    165. 

  165.     (modify-syntax-entry ?\\ "." st)
    166. 

  166.     (modify-syntax-entry ?\] ")[" st)
    167. 

  167.     (modify-syntax-entry ?^  "w" st)
    168. 

  168.     (modify-syntax-entry ?\_ "w" st)
    169. 

  169.     (modify-syntax-entry ?\{ "(}" st)
    170. 

  170.     (modify-syntax-entry ?\| "." st)
    171. 

  171.     (modify-syntax-entry ?\} "){" st)
    172. 

  172.     st)
    173. 

  173.   "Syntax table for `nmcobol-mode'.")
    174. 

  174. 

  175. ;;; KEY MAP
    176. 

  176. 

  177. (defvar nmcobol-skeleton-map
    178. 

  178.   (let ((map (make-sparse-keymap)))
    179. 

  179.     (define-key map [?i]   'nmcobol-if-skel)
    180. 

  180.     (define-key map [?p]   'nmcobol-paragraph-skel)
    181. 

  181.     map)
    182. 

  182.   "Keymap for `nmcobol-mode'.")
    183. 

  183. 

  184. (defvar nmcobol-eldoc-map
    185. 

  185.   (let ((map (make-sparse-keymap)))
    186. 

  186.     (define-key map [?m]   'nmcobol-eldoc-make-list)
    187. 

  187.     (define-key map [?s]   'nmcobol-eldoc-scan-buffer)
    188. 

  188.     (define-key map [?v]   'nmcobol-eldoc-visit-file)
    189. 

  189.     (define-key map [?w]   'nmcobol-eldoc-where-def)
    190. 

  190.     map)
    191. 

  191.   "Keymap for `nmcobol-mode'.")
    192. 

  192. 

  193. (defvar nmcobol-mode-map
    194. 

  194.   (let ((map (make-sparse-keymap)))
    195. 

  195.     (define-key map [tab]             'indent-according-to-mode)
    196. 

  196.     (define-key map [?\C-c ?\C-c]     'column-marker-here)
    197. 

  197.     (define-key map [?\C-c ?\C-e]      nmcobol-eldoc-map)
    198. 

  198.     (define-key map [?\C-c ?\C-f]     'auto-fill-mode)
    199. 

  199.     (define-key map [?\C-c ?\C-o]     'nmcobol-customize-options)
    200. 

  200.     (define-key map [?\C-c ?\C-r]     'popup-ruler)
    201. 

  201.     (define-key map [?\C-c ?\C-s]      nmcobol-skeleton-map)
    202. 

  202.     (define-key map [?\C-c ?=]        'nmcobol-addup-pics)
    203. 

  203.     (define-key map [?\C-c return]    'comment-indent-new-line)
    204. 

  204.     (define-key map [?*]              'nmcobol-char-maybe-comment)
    205. 

  205.     (define-key map [?/]              'nmcobol-char-maybe-comment)
    206. 

  206.     map)
    207. 

  207.   "Keymap for `nmcobol-mode'.")
    208. 

  208. 

  209. (defun nmcobol-setup-menu ()
    210. 

  210.   "Adds a menu of NMCOBOL specific functions to the menu bar."
    211. 

  211.   (define-key (current-local-map) [menu-bar nmcobol-menu]
    212. 

  212.     (cons "NMCobol" (make-sparse-keymap "NMCobol")))
    213. 

  213.   (define-key (current-local-map) [menu-bar nmcobol-menu customize]
    214. 

  214.     '(menu-item "Customize" nmcobol-customize-options
    215. 

  215.                 :key-sequence [?\C-c ?\C-o]
    216. 

  216.                 :help "Customize nmcobol-mode options"))
    217. 

  217.   (define-key (current-local-map) [menu-bar nmcobol-menu comment-eol]
    218. 

  218.     '(menu-item "Comment EOL" comment-indent-new-line
    219. 

  219.                 :key-sequence [?\C-c return]
    220. 

  220.                 :help "Continues comment on new line"))
    221. 

  221.   (if (featurep 'column-marker)
    222. 

  222.       (define-key (current-local-map) [menu-bar nmcobol-menu column]
    223. 

  223.         '(menu-item "Column Marker" column-marker-here
    224. 

  224.                     :key-sequence [?\C-c ?\C-c]
    225. 

  225.                     :help "Puts column marker at current column (C-u removes)")))
    226. 

  226.   (define-key (current-local-map) [menu-bar nmcobol-menu ruler]
    227. 

  227.     '(menu-item "Ruler" popup-ruler
    228. 

  228.                 :key-sequence [?\C-c ?\C-r]
    229. 

  229.                 :help "Inserts temporary ruler"))
    230. 

  230.   (define-key (current-local-map) [menu-bar nmcobol-menu eldoc-show]
    231. 

  231.     '(menu-item "Eldoc Where" nmcobol-eldoc-where-def
    232. 

  232.                 :key-sequence [?\C-c ?\C-e ?w]
    233. 

  233.                 :help "Shows Where function at point is defined"))
    234. 

  234.   (define-key (current-local-map) [menu-bar nmcobol-menu eldoc-visit]
    235. 

  235.     '(menu-item "Eldoc Visit" nmcobol-eldoc-visit-file
    236. 

  236.                 :key-sequence [?\C-c ?\C-e ?v]
    237. 

  237.                 :help "Visits file defining function at point"))
    238. 

  238.   (define-key (current-local-map) [menu-bar nmcobol-menu eldoc-update]
    239. 

  239.     '(menu-item "Eldoc Scan" nmcobol-eldoc-scan-buffer
    240. 

  240.                 :key-sequence [?\C-c ?\C-e ?s]
    241. 

  241.                 :help "Updates buffer-local eldoc entries (in memory)"))
    242. 

  242.   (define-key (current-local-map) [menu-bar nmcobol-menu eldoc-create]
    243. 

  243.     '(menu-item "Eldoc Make List" nmcobol-eldoc-make-list
    244. 

  244.                 :key-sequence [?\C-c ?\C-e ?m]
    245. 

  245.                 :help "Puts current file eldoc entries in a file."))
    246. 

  246.   (define-key (current-local-map) [menu-bar nmcobol-menu skeletons]
    247. 

  247.     (cons "Skeletons" (make-sparse-keymap "Skeletons")))
    248. 

  248.   (define-key (current-local-map) [menu-bar nmcobol-menu skeletons if]
    249. 

  249.     '(menu-item "If Then" nmcobol-if-skel
    250. 

  250.                 :key-sequence [?\C-c ?\C-s ?i]
    251. 

  251.                 :help "Inserts an If/Then statement"))
    252. 

  252.   (define-key (current-local-map) [menu-bar nmcobol-menu skeletons paragraph]
    253. 

  253.     '(menu-item "New Paragraph" nmcobol-paragraph-skel
    254. 

  254.                 :key-sequence [?\C-c ?\C-s ?p]
    255. 

  255.                 :help "Inserts comment bars for new paragraph name")))
    256. 

  256. 

  257. ;; All keyword lists get sorted so new words can be anywhere within the
    258. 

  258. ;; appropriate list.  The keywords are currently only used for highlighting but
    259. 

  259. ;; more uses such as abbrev-mode are in progress.
    260. 

  260. 

  261. (defvar nmcobol-keywords-directives     ;font-lock-preprocessor-face
    262. 

  262.   '( "ANSI"            "BLANK"           "CALL-SHARED"     "CANCEL"
    263. 

  263.      "CHECK"           "CODE"            "COLUMNS"         "COMPACT"
    264. 

  264.      "COMPILE"         "CONSULT"         "CROSSREF"        "DIAGNOSE-74"
    265. 

  265.      "DIAGNOSE-85"     "DIAGNOSEALL"     "ENDIF"           "ENDUNIT"
    266. 

  266.      "ENV"             "ERRORFILE"       "ERRORS"          "FIPS"
    267. 

  267.      "FMAP"            "HEADING"         "HEAP"            "HIGHPIN"
    268. 

  268.      "HIGHREQUESTERS"  "ICODE"           "IF"              "IFNOT"
    269. 

  269.      "INNERLIST"       "INSPECT"         "LARGEDATA"       "LD"
    270. 

  270.      "LESS-CODE"       "LIBRARY"         "LINES"           "LIST"
    271. 

  271.      "LMAP"            "MAIN"            "MAP"             "NLD"
    272. 

  272.      "NOBLANK"         "NOCANCEL"        "NOCODE"          "NOCOMPACT"
    273. 

  273.      "NOCONSULT"       "NOCROSSREF"      "NODIAGNOSE-74"   "NODIAGNOSE-85"
    274. 

  274.      "NODIAGNOSEALL"   "NOFIPS"          "NOICODE"         "NOINNERLIST"
    275. 

  275.      "NOINSPECT"       "NOLIST"          "NOLMAP"          "NOMAP"
    276. 

  276.      "NON-SHARED"      "NONSTOP"         "NOPORT"          "NOSAVEABEND"
    277. 

  277.      "NOSEARCH"        "NOSHOWCOPY"      "NOSHOWFILE"      "NOSQL"
    278. 

  278.      "NOSUPPRESS"      "NOSYMBOLS"       "NOTRAP2"         "NOTRAP2-74"
    279. 

  279.      "NOWARN"          "OPTIMIZE"        "PERFORM-TRACE"   "PORT"
    280. 

  280.      "RESETTOG"        "RUNNABLE"        "RUNNAMED"        "SAVE"
    281. 

  281.      "SAVEABEND"       "SEARCH"          "SECTION"         "SETTOG"
    282. 

  282.      "SHARED"          "SHOWCOPY"        "SHOWFILE"        "SOURCE"
    283. 

  283.      "SQL"             "SQLMEM"          "SUBSET"          "SUBTYPE"
    284. 

  284.      "SUPPRESS"        "SYMBOLS"         "SYNTAX"          "TANDEM"
    285. 

  285.      "TRAP2"           "TRAP2-74"        "UL"              "WARN")
    286. 

  286.   "List of NMCOBOL compiler directives.
    287. 

  287. Used to create the `font-lock-keywords' table.")
    288. 

    289. 

  289. (defvar nmcobol-keywords-imperatives
    290. 

  290.   '( "ACCEPT"        "DISPLAY"       "MULTIPLY"      "STOP"
    291. 

  291.      "ADD"           "DIVIDE"        "OPEN"          "STRING"
    292. 

  292.      "ALTER"         "ENTER"         "PERFORM"       "SUBTRACT"
    293. 

  293.      "CALL"          "EXIT"          "READ"          "UNLOCKFILE"
    294. 

  294.      "CANCEL"        "GO TO"         "RELEASE"       "UNLOCKRECORD"
    295. 

  295.      "INITIALIZE"    "REWRITE"       "UNSTRING"      "CLOSE"
    296. 

  296.      "INSPECT"       "SET"           "WRITE"         "COMPUTE"
    297. 

  297.      "LOCKFILE"      "SORT"          "CONTINUE"      "MERGE"
    298. 

  298.      "START"         "DELETE"        "MOVE")
    299. 

  299.   "List of NMCOBOL keywords identifying an imperative statement.
    300. 

  300. Used by indentation routines in their determination of such."
    301. 

  301. )
    302. 

    303. 

  303. (defvar nmcobol-block-keywords
    304. 

  304.   '("ADD"            "COMPUTE"        "DELETE"         "DIVIDE"
    305. 

  305.     "EVALUATE"       "IF"             "MULTIPLY"       "PERFORM"
    306. 

  306.     "READ"           "REWRITE"        "SEARCH"         "START"
    307. 

  307.     "STRING"         "SUBTRACT"       "UNSTRING"       "WRITE"
    308. 

  308.    )
    309. 

  309.   "A list of words that should have open paren syntax - conditionally.
    310. 

  310. `nmcobol-get-block-type' determines if they actually require the
    311. 

  311. END-<word> statement." )
    312. 

    313. 

  313. (defvar nmcobol-keywords-statements     ;font-lock-keyword-face
    314. 

  314.   '("ACCEPT"        "ADD"           "ALTER"         "CALL"          
    315. 

  315.     "CANCEL"        "CHECKPOINT"    "CLOSE"         "COMPUTE"       
    316. 

  316.     "CONTINUE"      "COPY"          "DELETE"        "DISPLAY"       
    317. 

  317.     "DIVIDE"        "ELSE"          "END"           "END-ADD"       
    318. 

  318.     "END-COMPUTE"   "END-DELETE"    "END-DIVIDE"    "END-EVALUATE"  
    319. 

  319.     "END-IF"        "END-MULTIPLY"  "END-OF-PAGE"   "END-PERFORM"   
    320. 

  320.     "END-READ"      "END-RECEIVE"   "END-RETURN"    "END-REWRITE"   
    321. 

  321.     "END-SEARCH"    "END-START"     "END-STRING"    "END-SUBTRACT"  
    322. 

  322.     "END-UNSTRING"  "END-WRITE"     "ENTER COBOL"   "ENTER"         
    323. 

  323.     "EVALUATE"      "EXIT"          "FD"            "FILE"          
    324. 

  324.     "GO TO"         "IF"            "INITIALIZE"    "INSPECT"       
    325. 

  325.     "LOCKFILE"      "MERGE"         "MOVE"          "MULTIPLY"      
    326. 

  326.     "OPEN"          "PERFORM"       "READ"          "RELEASE"       
    327. 

  327.     "REPLACE"       "RETURN"        "REWRITE"       "SD"            
    328. 

  328.     "SEARCH"        "SELECT"        "SET"           "SORT"          
    329. 

  329.     "START"         "STARTBACKUP"   "STOP"          "STRING"        
    330. 

  330.     "SUBTRACT"      "THEN"          "UNLOCKFILE"    "UNLOCKRECORD"  
    331. 

  331.     "UNSTRING"      "USE"           "WHEN"          "WRITE"         )
    332. 

  332.   "List of NMCOBOL statement keywords.
    333. 

  333. Used to create the `font-lock-keywords' table.")
    334. 

    335. 

  335. (defvar nmcobol-keywords-deprecated     ;font-lock-warning-face
    336. 

  336.   '( "STARTBACKUP" "CHECKPOINT")
    337. 

  337.   "List of NMCOBOL keywords and Builtin functions now deprecated.
    338. 

  338. Used to create the `font-lock-keywords' table")
    339. 

    340. 

  340. (defvar nmcobol-keywords-reserved       ;font-lock-type-face
    341. 

  341.   '( "ACCEPT"                 "ACCESS"                 "ADD"
    342. 

  342.      "ADDRESS"                "ADVANCING"              "AFTER"
    343. 

  343.      "ALL"                    "ALPHABET"               "ALPHABETIC"
    344. 

  344.      "ALPHABETIC-LOWER"       "ALPHABETIC-UPPER"       "ALPHANUMERIC"
    345. 

  345.      "ALPHANUMERIC-EDITED"    "ALSO"                   "ALTER"
    346. 

  346.      "ALTERNATE"              "AND"                    "ANY"
    347. 

  347.      "APPROXIMATE"            "AREA"                   "AREAS"
    348. 

  348.      "ASCENDING"              "ASSIGN"                 "AT"
    349. 

  349.      "AUTHOR"                 "BEFORE"                 "BINARY"
    350. 

  350.      "BLANK"                  "BLOCK"                  "BOTTOM"
    351. 

  351.      "BY"                     "CALL"                   "CANCEL"
    352. 

  352.      "CD"                     "CF"                     "CH"
    353. 

  353.      "CHARACTER"              "CHARACTERS"             "CHARACTER-SET"
    354. 

  354.      "CHECKPOINT"             "CLASS"                  "CLOCK-UNITS"
    355. 

  355.      "CLOSE"                  "COBOL"                  "CODE"
    356. 

  356.      "CODE-SET"               "COLLATING"              "COLUMN"
    357. 

  357.      "COMMA"                  "COMMON"                 "COMMUNICATION"
    358. 

  358.      "COMP"                   "COMP-3"                 "COMP-5"
    359. 

  359.      "COMPUTATIONAL"          "COMPUTATIONAL-3"        "COMPUTATIONAL-5"
    360. 

  360.      "COMPUTE"                "CONFIGURATION"          "CONTAINS"
    361. 

  361.      "CONTENT"                "CONTINUE"               "CONTROL"
    362. 

  362.      "CONTROLS"               "CONVERTING"             "COPY"
    363. 

  363.      "CORR"                   "CORRESPONDING"          "COUNT"
    364. 

  364.      "CURRENCY"               "DATA"                   "DATE"
    365. 

  365.      "DATE-COMPILED"          "DATE-WRITTEN"           "DAY"
    366. 

  366.      "DAY-OF-WEEK"            "DE"                     "DEBUG-CONTENTS"
    367. 

  367.      "DEBUG-ITEM"             "DEBUG-LINE"             "DEBUG-SUB-2"
    368. 

  368.      "DEBUG-SUB-3"            "DEBUGGING"              "DECIMAL-POINT"
    369. 

  369.      "DECLARATIVES"           "DEBUG-NAME"             "DEBUG-SUB-1"
    370. 

  370.      "DELETE"                 "DELIMITED"              "DELIMITER"
    371. 

  371.      "DEPENDING"              "DESCENDING"             "DESTINATION"
    372. 

  372.      "DETAIL"                 "DISABLE"                "DISPLAY"
    373. 

  373.      "DIVIDE"                 "DIVISION"               "DOWN"
    374. 

  374.      "DUPLICATES"             "DYNAMIC"                "EGI"
    375. 

  375.      "ELSE"                   "EMI"                    "ENABLE"
    376. 

  376.      "END"                    "END-ADD"                "END-COMPUTE"
    377. 

  377.      "END-DELETE"             "END-DIVIDE"             "END-EVALUATE"
    378. 

  378.      "END-IF"                 "END-MULTIPLY"           "END-OF-PAGE"
    379. 

  379.      "END-PERFORM"            "END-READ"               "END-RECEIVE"
    380. 

  380.      "END-RETURN"             "END-REWRITE"            "END-SEARCH"
    381. 

  381.      "END-START"              "END-STRING"             "END-SUBTRACT"
    382. 

  382.      "END-UNSTRING"           "END-WRITE"              "ENTER"
    383. 

  383.      "EOP"                    "EQUAL"                  "ERROR"
    384. 

  384.      "ESI"                    "EVALUATE"               "EVERY"
    385. 

  385.      "EXCEPTION"              "EXCLUSIVE"              "EXIT"
    386. 

  386.      "EXTEND"                 "EXTENDED-STORAGE"       "EXTERNAL"
    387. 

  387.      "FALSE"                  "FD"                     "FILE"
    388. 

  388.      "FILE-CONTROL"           "FILLER"                 "FINAL"
    389. 

  389.      "FIRST"                  "FOOTING"                "FOR"
    390. 

  390.      "FROM"                   "FUNCTION"               "GENERATE"
    391. 

  391.      "GENERIC"                "GIVING"                 "GLOBAL"
    392. 

  392.      "GO"                     "GREATER"                "GROUP"
    393. 

  393.      "GUARDIAN-ERR"           "HEADING"                "HIGH-VALUE"
    394. 

  394.      "HIGH-VALUES"            "I-O"                    "I-O-CONTROL"
    395. 

  395.      "IDENTIFICATION"         "IF"                     "IN"
    396. 

  396.      "INDEX"                  "INDEXED"                "INDICATE"
    397. 

  397.      "INITIAL"                "INITIALIZE"             "INITIATE"
    398. 

  398.      "INPUT"                  "INPUT-OUTPUT"           "INSPECT"
    399. 

  399.      "INSTALLATION"           "INTO"                   "INVALID"
    400. 

  400.      "IS"                     "JUST"                   "JUSTIFIED"
    401. 

  401.      "KEY"                    "LABEL"                  "LAST"
    402. 

  402.      "LEADING"                "LEFT"                   "LENGTH"
    403. 

  403.      "LESS"                   "LIMIT"                  "LIMITS"
    404. 

  404.      "LINAGE"                 "LINAGE-COUNTER"         "LINE"
    405. 

  405.      "LINE-COUNTER"           "LINKAGE"                "LOCK"
    406. 

  406.      "LOCKFILE"               "LOW-VALUE"              "LOW-VALUES"
    407. 

  407.      "MEMORY"                 "MERGE"                  "MESSAGE"
    408. 

  408.      "MODE"                   "MODULES"                "MOVE"
    409. 

  409.      "MULTIPLE"               "MULTIPLY"               "NATIVE"
    410. 

  410.      "NEGATIVE"               "NEXT"                   "NO"
    411. 

  411.      "NOT"                    "NULL"                   "NULLS"
    412. 

  412.      "NUMBER"                 "NUMERIC"                "NUMERIC-EDITED"
    413. 

  413.      "OBJECT-COMPUTER"        "OCCURS"                 "OF"
    414. 

  414.      "OFF"                    "OMITTED"                "ON"
    415. 

  415.      "OPEN"                   "OPTIONAL"               "OR"
    416. 

  416.      "ORDER"                  "ORGANIZATION"           "OTHER"
    417. 

  417.      "OUTPUT"                 "OVERFLOW"               "PACKED-DECIMAL"
    418. 

  418.      "PADDING"                "PAGE"                   "PAGE-COUNTER"
    419. 

  419.      "PERFORM"                "PF"                     "PH"
    420. 

  420.      "PIC"                    "PICTURE"                "PLUS"
    421. 

  421.      "POINTER"                "POSITION"               "POSITIVE"
    422. 

  422.      "PRINTING"               "PROCEDURE"              "PROCEDURES"
    423. 

  423.      "PROCEED"                "PROGRAM"                "PROGRAM-ID"
    424. 

  424.      "PROGRAM-STATUS"         "PROGRAM-STATUS-1"       "PROGRAM-STATUS-2"
    425. 

  425.      "PROMPT"                 "PROTECTED"              "PURGE"
    426. 

  426.      "QUEUE"                  "QUOTE"                  "QUOTES"
    427. 

  427.      "RANDOM"                 "RD"                     "READ"
    428. 

  428.      "RECEIVE"                "RECEIVE-CONTROL"        "RECORD"
    429. 

  429.      "RECORDS"                "REDEFINES"              "REEL"
    430. 

  430.      "REFERENCE"              "REFERENCES"             "RELATIVE"
    431. 

  431.      "RELEASE"                "REMAINDER"              "REMOVAL"
    432. 

  432.      "RENAMES"                "REPLACE"                "REPLACING"
    433. 

  433.      "REPLY"                  "REPORT"                 "REPORTING"
    434. 

  434.      "REPORTS"                "RERUN"                  "RESERVE"
    435. 

  435.      "RESET"                  "RETURN"                 "REVERSED"
    436. 

  436.      "REWIND"                 "REWRITE"                "RF"
    437. 

  437.      "RH"                     "RIGHT"                  "ROUNDED"
    438. 

  438.      "RUN"                    "SAME"                   "SD"
    439. 

  439.      "SEARCH"                 "SECTION"                "SECURITY"
    440. 

  440.      "SEGMENT"                "SEGMENT-LIMIT"          "SELECT"
    441. 

  441.      "SEND"                   "SENTENCE"               "SEPARATE"
    442. 

  442.      "SEQUENCE"               "SEQUENTIAL"             "SET"
    443. 

  443.      "SHARED"                 "SIGN"                   "SIZE"
    444. 

  444.      "SORT"                   "SORT-MERGE"             "SOURCE"
    445. 

  445.      "SOURCE-COMPUTER"        "SPACE"                  "SPACES"
    446. 

  446.      "SPECIAL-NAMES"          "STANDARD"               "STANDARD-1"
    447. 

  447.      "STANDARD-2"             "START"                  "STARTBACKUP"
    448. 

  448.      "STATUS"                 "STOP"                   "STRING"
    449. 

  449.      "SUB-QUEUE-1"            "SUB-QUEUE-2"            "SUB-QUEUE-3"
    450. 

  450.      "SUBTRACT"               "SUM"                    "SUPPRESS"
    451. 

  451.      "SYMBOLIC"               "SYNC"                   "SYNCDEPTH"
    452. 

  452.      "SYNCHRONIZED"           "TABLE"                  "TAL"
    453. 

  453.      "TALLYING"               "TAPE"                   "TERMINAL"
    454. 

  454.      "TERMINATE"              "TEST"                   "TEXT"
    455. 

  455.      "THAN"                   "THEN"                   "THROUGH"
    456. 

  456.      "THRU"                   "TIME"                   "TIMES"
    457. 

  457.      "TO"                     "TOP"                    "TRAILING"
    458. 

  458.      "TRUE"                   "TYPE"                   "UNIT"
    459. 

  459.      "UNLOCK"                 "UNLOCKFILE"             "UNLOCKRECORD"
    460. 

  460.      "UNSTRING"               "UNTIL"                  "UP"
    461. 

  461.      "UPON"                   "USAGE"                  "USE"
    462. 

  462.      "USING"                  "VALUE"                  "VALUES"
    463. 

  463.      "VARYING"                "WHEN"                   "WITH"
    464. 

  464.      "WORDS"                  "WORKING-STORAGE"        "WRITE"
    465. 

  465.      "ZERO"                   "ZEROES")
    466. 

  466.   "List of NMCOBOL keywords reserved only in certain language contexts.
    467. 

  467. Used to create the `font-lock-keywords' table.")
    468. 

    469. 

  469. (defvar nmcobol-keywords-std-fcns       ;font-lock-keyword-face
    470. 

  470.   '( "ACOS"                   "ANNUITY"                "ASIN"
    471. 

  471.      "ATAN"                   "CHAR"                   "COS"
    472. 

  472.      "CURRENT-DATE"           "DATE-OF-INTEGER"        "DAY-OF-INTEGER"
    473. 

  473.      "FACTORIAL"              "INTEGER"                "INTEGER-OF-DATE"
    474. 

  474.      "INTEGER-OF-DAY"         "INTEGER-PART"           "LENGTH"
    475. 

  475.      "LOG"                    "LOG10"                  "LOWER-CASE"
    476. 

  476.      "MAX"                    "MEAN"                   "MEDIAN"
    477. 

  477.      "MIDRANGE"               "MIN"                    "MOD"
    478. 

  478.      "NUMVAL"                 "NUMVAL-C"               "ORD"
    479. 

  479.      "ORD-MAX"                "ORD-MIN"                "PRESENT-VALUE"
    480. 

  480.      "RANDOM"                 "RANGE"                  "REM"
    481. 

  481.      "REVERSE"                "SIN"                    "SQRT"
    482. 

  482.      "STANDARD-DEVIATION"     "SUM"                    "TAN"
    483. 

  483.      "UPPER-CASE"             "VARIANCE"               "WHEN-COMPILED")
    484. 

  484.   "List of NMCOBOL standard functions.
    485. 

  485. Used to create the `font-lock-keywords' table.")
    486. 

    487. 

  487. (defvar nmcobol-keywords-privileged     ;font-lock-warning-face
    488. 

  488.   '( "END-EXEC" "EXEC")
    489. 

  489.   "List of NMCOBOL privileged functions.
    490. 

  490. Used to create the `font-lock-keywords' table.")
    491. 

    492. 

  492. (defvar nmcobol-keywords-builtin        ;font-lock-variable-name-face
    493. 

  493.   '( "#IN"                             "#OUT"
    494. 

  494.      "#TERM"                           "#TEMP"
    495. 

  495.      "#DYNAMIC"                        "COBOL85^ARMTRAP"
    496. 

  496.      "COBOL85^COMPLETION"              "COBOL_COMPLETION_"
    497. 

  497.      "COBOL_CONTROL_"                  "COBOL_GETENV_"
    498. 

  498.      "COBOL_PUTENV_"                   "COBOL85^RETURN^SORT^ERRORS"
    499. 

  499.      "COBOL_RETURN_SORT_ERRORS_"       "COBOL85^REWIND^SEQUENTIAL"
    500. 

  500.      "COBOL_REWIND_SEQUENTIAL_"        "COBOL85^SET^SORT^PARAM^TEXT"
    501. 

  501.      "COBOL_SET_SORT_PARAM_TEXT_"      "COBOL85^SET^SORT^PARAM^VALUE"
    502. 

  502.      "COBOL_SET_SORT_PARAM_VALUE_"     "COBOL_SET_MAX_RECORD_"
    503. 

  503.      "COBOL_SETMODE_"                  "COBOL85^SPECIAL^OPEN"
    504. 

  504.      "COBOL_SPECIAL_OPEN_"             "COBOLASSIGN"
    505. 

  505.      "COBOL_ASSIGN_"                   "COBOLFILEINFO"
    506. 

  506.      "COBOL_FILE_INFO_"                "COBOLSPOOLOPEN"
    507. 

  507.      "CREATEPROCESS"                   "ALTERPARAMTEXT"
    508. 

  508.      "CHECKLOGICALNAME"                "CHECKMESSAGE"
    509. 

  509.      "DELETEASSIGN"                    "DELETEPARAM"
    510. 

  510.      "DELETESTARTUP"                   "GETASSIGNTEXT"
    511. 

  511.      "GETASSIGNVALUE"                  "GETBACKUPCPU"
    512. 

  512.      "GETPARAMTEXT"                    "GETSTARTUPTEXT"
    513. 

  513.      "PUTASSIGNTEXT"                   "PUTASSIGNVALUE"
    514. 

  514.      "PUTPARAMTEXT"                    "PUTSTARTUPTEXT")
    515. 

  515.   "List of NMCOBOL privileged builtin functions.
    516. 

  516. Used to create the `font-lock-keywords' table.")
    517. 

    518. 

  518. (defcustom nmcobol-block-always-keywords
    519. 

  519.   '("ELSE"      "EVALUATE"  "IF"        "SEARCH"    "THEN"      
    520. 

  520.     "WHEN"      )
    521. 

  521.   "List of keywords that always require and END-<word>. Used in paren matching."
    522. 

  522.   :type  '(repeat (string :tag "word"))
    523. 

  523.   :group 'nmcobol)
    524. 

    525. 

  525. (defcustom nmcobol-keyword-section-names-regexp
    526. 

  526.   "^\\s-\\{1,3\\}\\(\\w+\\)\\s-+\\(division\\(\\s-+using\\s-+[^.\n]+\\)?\\|section\\) *\\."
    527. 

  527.   "Defines a regexp that finds the names of divisions & sections.
    528. 

  528. Used to create the `font-lock-keywords' table."
    529. 

  529.   :type  'regexp
    530. 

  530.   :group 'nmcobol)
    531. 

    532. 

  532. (defcustom nmcobol-keyword-fcn-names-regexp
    533. 

  533.   "^\\s-\\{1,3\\}\\(\\w+\\)\\s-*\\."
    534. 

  534.   "Defines a regexp that finds the names of paragraphs.
    535. 

  535. Used by `font-lock-keywords'. See also `nmcobol-imenu-fcn-names-regexp'"
    536. 

  536.   :type  'regexp
    537. 

  537.   :group 'nmcobol)
    538. 

    539. 

  539. ;;; Build keyword regexp from keyword lists
    540. 

  540. 

  541. (defvar nmcobol-keywords-imperatives-regexp ()
    542. 

  542.   "regexp matching `nmcobol-keywords-imperatives'")
    543. 

  543. (defvar nmcobol-keywords-statements-regexp ()
    544. 

  544.   "regexp matching `nmcobol-keywords-statements'")
    545. 

  545. (defvar nmcobol-keywords-reserved-regexp ()
    546. 

  546.   "regexp matching `nmcobol-keywords-reserved'")
    547. 

  547. (defvar nmcobol-block-always-regexp ()
    548. 

  548.   "regexp matching `nmcobol-block-always-keywords'")
    549. 

  549. (defvar nmcobol-block-begin-regexp ()
    550. 

  550.   "regexp matching `nmcobol-block-keywords'")
    551. 

  551. (defvar nmcobol-block-end-regexp ()
    552. 

  552.   "regexp matching \"END-\" + `nmcobol-block-keywords'")
    553. 

  553. (defvar nmcobol-non-cobol-regexp
    554. 

  554.   "^[*/?]"
    555. 

  555.   "Expression describing comment and compiler directive lines.")
    556. 

  556. 

  557. (defun nmcobol-setup-regexp-vars ()
    558. 

  558.   "Rebuilds regexp variables from keyword lists."
    559. 

  559.   (setq nmcobol-keywords-imperatives-regexp
    560. 

  560.         (concat (regexp-opt nmcobol-keywords-imperatives t) "\\(\\s-\\|\\.\\)")
    561. 

  561.         nmcobol-keywords-statements-regexp
    562. 

  562.         (concat "^\\([ \t]+\\)"
    563. 

  563.                 (regexp-opt nmcobol-keywords-statements t) "\\(\\s-\\|\\.\\)")
    564. 

  564.         nmcobol-keywords-reserved-regexp ;not used!
    565. 

  565.         (nmcobol-keyword-anywhere-regexp nmcobol-keywords-reserved)
    566. 

  566.         nmcobol-block-always-regexp
    567. 

  567.         (concat (regexp-opt nmcobol-block-always-keywords t) "\\(\\s-\\|\\.\\)")
    568. 

  568.         nmcobol-block-begin-regexp
    569. 

  569.         (regexp-opt nmcobol-block-keywords  t)
    570. 

  570.         nmcobol-block-end-regexp
    571. 

  571.         (concat "END-" (regexp-opt nmcobol-block-keywords  t))))
    572. 

  572. 

  573. ;;; Font lock (highlighting)
    574. 

  574. 

  575. (defcustom nmcobol-font-lock-always t
    576. 

  576.   "`nmcobol-mode' makes sure `font-lock-mode' is on for nmcobol-mode buffers.
    577. 

  577. Some things don't work if it's off so insuring it's on is the default."
    578. 

  578.   :type 'boolean
    579. 

  579.   :group 'nmcobol)
    580. 

    581. 

  581. (defcustom nmcobol-primecode-warning t
    582. 

  582.   "Highlight instances of ]a ]d and ]e in column 1 with a warning face.
    583. 

  583. This alerts you that submission of this file to RMS/PrimeCode will fail
    584. 

  584. due to invalid contents.  nil disables this warning."
    585. 

  585.   :type 'boolean
    586. 

  586.   :group 'nmcobol)
    587. 

    588. 

  588. (defun nmcobol-keyword-special-regexp ( word-list )
    589. 

  589.   "Returns a regexp that finds any of the words in WORD-LIST.
    590. 

  590. But only if the keyword is surrounded by non-word chars."
    591. 

  591.   (concat "\\W"(regexp-opt word-list t)"\\W"))
    592. 

  592. 

  593. (defun nmcobol-keyword-anywhere-regexp ( word-list )
    594. 

  594.   "Returns a regexp that finds any of the words in WORD-LIST.
    595. 

  595. But only if the keyword is surrounded by non-word chars."
    596. 

  596.   (concat "\\b"(regexp-opt word-list t)"\\b"))
    597. 

  597. 

  598. ;; The next 4 def's work tightly together and, as coded, cannot be reused for
    599. 

  599. ;; additional purposes.
    600. 

  600. (defvar nmcobol-keyword-on-directive-line-regexp () "Internal use only.")
    601. 

  601. (defun  nmcobol-keyword-on-directive-line-regexp ( word-list )
    602. 

  602. "Returns a function to find WORD-LIST only if line starts with ?"
    603. 

  603.   (setq nmcobol-keyword-on-directive-line-regexp
    604. 

  604.         (concat "\\b"(regexp-opt word-list t)"\\b"))
    605. 

  605.   'nmcobol-font-lock-directive-line)
    606. 

  606. (defvar nmcobol-amid-font-lock-excursion nil
    607. 

  607.   "Used by `nmcobol-font-lock-directive-line'.  When a line starting with
    608. 

  608. ? in column 1 is detected this variable holds the context needed to
    609. 

  609. continue searching for more keywords.  If nil a line starting with ?
    610. 

  610. should be searched for.")
    611. 

  611. (make-variable-buffer-local 'nmcobol-amid-font-lock-excursion)
    612. 

  612. (defun nmcobol-font-lock-directive-line ( search-limit )
    613. 

  613.   "This function finds keywords only in lines starting with ?.  Valid
    614. 

  614. keywords are described by `nmcobol-keyword-on-directive-line-regexp'.
    615. 

  615. First a line beginning with ? is searched for.  Once found, point is
    616. 

  616. moved to the beginning of that area and limit is set to the end.
    617. 

  617. Keywords are searched for within that range.  If found, context is saved
    618. 

  618. in nmcobol-amid-font-lock-excursion and the match-data is returned.  If
    619. 

  619. not found, another line starting with ?  is searched for.  If saved
    620. 

  620. context exists when this function is called then another keyword is
    621. 

  621. searched for in the previously narrowed region.  If none is found the
    622. 

  622. next region is searched for."
    623. 

  623.   (let ((looking t))
    624. 

  624.     (while
    625. 

  625.         (and looking
    626. 

  626.              (or nmcobol-amid-font-lock-excursion
    627. 

  627.           (when (re-search-forward "^\\?.+\n" search-limit t)
    628. 

  628.             (setq nmcobol-amid-font-lock-excursion (point))
    629. 

  629.             (goto-char (match-beginning 0)))))
    630. 

  630.       (if (re-search-forward nmcobol-keyword-on-directive-line-regexp
    631. 

  631.                nmcobol-amid-font-lock-excursion t)
    632. 

  632.           (setq looking nil)
    633. 

  633.         (goto-char nmcobol-amid-font-lock-excursion)
    634. 

  634.         (setq nmcobol-amid-font-lock-excursion nil)))
    635. 

  635.     (not looking)))
    636. 

    637. 

  637. (defvar nmcobol-find-syntactic--state ()
    638. 

  638.   "Used by `nmcobol-find-syntactic-keywords' to find multiple syntactic
    639. 

  639. elements which all must be anchored to the beginning of a line.
    640. 

  640. nil    = No searches on this line yet. skip line if it's a directive.
    641. 

  641. 0      = look for sequence number in col 1-6 (removed)
    642. 

  642. 1      = sequence/label area checked. look at body.
    643. 

  643. 2      = body not a comment, any trailing comment marked, check for strings
    644. 

  644. marker = terminated string found check for more.")
    645. 

  645. (make-variable-buffer-local 'nmcobol-find-syntactic--state)
    646. 

  646. (defun nmcobol-find-syntactic-keywords ( search-limit )
    647. 

  647.   "Used by `font-lock-syntactic-keywords' to find comments and strings.
    648. 

  648. Returns t if either a comment or string is found, nil if neither is found.
    649. 

  649. match-data 1&2 are set for comments, 3&4 are set for a normal string, 5&6 are
    650. 

  650. set for eol-terminated strings.  Where the match pair mark the start character
    651. 

  651. and end character respectively.  Point is moved to the next line during this
    652. 

  652. function only after the last search completes for the current line.  A state
    653. 

  653. machine, controlled by `nmcobol-find-syntactic--state' sequences the searches."
    654. 

  654.   (let ((found nil)
    655. 

  655.         (save (point)))
    656. 

  656.     (while (and (< (point) search-limit)
    657. 

  657.                 (not found))
    658. 

  658.            (cond
    659. 

  659.             ;; no comments or quotes? in compiler directives
    660. 

  660.             ((or (null nmcobol-find-syntactic--state)
    661. 

  661.                  (equal nmcobol-find-syntactic--state (make-marker)))
    662. 

  662.              (if (looking-at "^\\?")
    663. 

  663.                  (forward-line 1)       ;do this state on next line
    664. 

  664.                (setq nmcobol-find-syntactic--state 1) ;do next state on this line
    665. 

  665.              ))
    666. 

  666.             ;; see if entire line is a comment
    667. 

  667.             ((= 1 nmcobol-find-syntactic--state)
    668. 

  668.              (if (not (looking-at "^\\(?:*\\|/\\)"))
    669. 

  669.                  (setq nmcobol-find-syntactic--state 2) ;goto next state
    670. 

  670.                ;; else set match data and point to next line
    671. 

  671.                (looking-at "\\(.\\).*\\(\n\\|\\'\\)") ;setup match-data
    672. 

  672.                (forward-line 1)    ;next iteration looks at next line
    673. 

  673.                (setq nmcobol-find-syntactic--state ()
    674. 

  674.                      found t)))
    675. 

  675.             ;; look for strings only within columns 8-72 inclusive
    676. 

  676.             ((= 2 nmcobol-find-syntactic--state)
    677. 

  677.              (if (looking-at "^[-d D][^\"\n]\\{0,130\\}\"")
    678. 

  678.                  (let* ((open-quote (list (copy-marker (1- (match-end 0)))
    679. 

  679.                                           (copy-marker (match-end 0))))
    680. 

  680.                         (leol (copy-marker (line-end-position)))
    681. 

  681.                         close-quote)
    682. 

  682.                    (setq found t)
    683. 

  683.                    (goto-char (cadr open-quote))
    684. 

  684.                    (if (search-forward "\"" leol t)
    685. 

  685.                        (progn           ; normally ending string
    686. 

  686.                          (setq close-quote (match-data)
    687. 

  687.                                nmcobol-find-syntactic--state (cadr close-quote))
    688. 

  688.                          (beginning-of-line)
    689. 

  689.                          (set-match-data
    690. 

  690.                           `(,(car open-quote) ,(cadr close-quote)
    691. 

  691.                             nil nil nil nil ;match-string 1&2 not found
    692. 

  692.                             ,@open-quote ,@close-quote)) ;3&4 are normal string
    693. 

  693.                        )
    694. 

  694.                      ;; implicit string end
    695. 

  695.                      (forward-line 1)   ;next iteration looks at next line
    696. 

  696.                      (setq close-quote (list (copy-marker (1- leol)) leol)
    697. 

  697.                            nmcobol-find-syntactic--state ())
    698. 

  698.                      (set-match-data
    699. 

  699.                       `(,(car open-quote) ,(cadr close-quote)
    700. 

  700.                         nil nil nil nil ;match-string 1&2 not found
    701. 

  701.                         nil nil nil nil ;match-string 3&4 not found
    702. 

  702.                         ,@open-quote ,@close-quote)) ;5&6 unterminated string
    703. 

  703.                    ))
    704. 

  704.                ;; no string was found.  Start new analysis on next line
    705. 

  705.                (forward-line 1)
    706. 

  706.                (setq nmcobol-find-syntactic--state ())))
    707. 

  707.             ;; a string has been found look for another after it
    708. 

  708.             ((markerp nmcobol-find-syntactic--state)
    709. 

  709.              (let ((leol (copy-marker (line-end-position)))
    710. 

  710.                    open-quote close-quote)
    711. 

  711.                (goto-char nmcobol-find-syntactic--state)
    712. 

  712.                (if (search-forward "\"" leol t)
    713. 

  713.                    (progn
    714. 

  714.                      (setq open-quote (match-data)
    715. 

  715.                            found t)
    716. 

  716.                      (if (search-forward "\"" leol t)
    717. 

  717.                          (progn         ; normally ending string
    718. 

  718.                            (beginning-of-line) ;next iteration starts here again
    719. 

  719.                            (setq close-quote (match-data)
    720. 

  720.                                  nmcobol-find-syntactic--state (cadr close-quote))
    721. 

  721.                            (set-match-data
    722. 

  722.                             `(,(car open-quote) ,(cadr close-quote)
    723. 

  723.                               nil nil nil nil ;match-string 1&2 not found
    724. 

  724.                               ,@open-quote ,@close-quote)) ;3&4 normal string
    725. 

  725.                          )
    726. 

  726.                        ;; implicit string end
    727. 

  727.                        (forward-line 1) ;next iteration looks at next line
    728. 

  728.                        (setq close-quote (list (copy-marker (1- leol)) leol)
    729. 

  729.                              nmcobol-find-syntactic--state ())
    730. 

  730.                        (set-match-data
    731. 

  731.                         `(,(car open-quote) ,(cadr close-quote)
    732. 

  732.                           nil nil nil nil ;match-string 1&2 not found
    733. 

  733.                           nil nil nil nil ;match-string 3&4 not found
    734. 

  734.                           ,@open-quote ,@close-quote)) ;5&6 unterminated string
    735. 

  735.                      ))
    736. 

  736.                  (forward-line 1)
    737. 

  737.                  (setq nmcobol-find-syntactic--state ()))))))
    738. 

  738.     ;; Point should not return forward of search-limit
    739. 

  739.     (and (> (point) search-limit) (goto-char search-limit))
    740. 

  740.     ;; point shouldn't move if nothing was found.
    741. 

  741.     (prog1 found (or found (goto-char save)))))
    742. 

    743. 

  743. (defvar nmcobol-static-font-lock-keywords
    744. 

  744.   ;; font-lock-keywords is a symbol or list of symbols yielding the keywords to
    745. 

  745.   ;; be fontified.  Keywords are listed here using either (MATCHER . FACENAME)
    746. 

  746.   ;; or (MATCHER . (MATCH FACENAME)) syntax.  Other options are available but
    747. 

  747.   ;; not used here.  For simplicity, all regexp's were designed so MATCH would
    748. 

  748.   ;; be 1.  Nothing forced this but to me it makes debug/maintenance easier.
    749. 

  749.   `(("^\\([^ ?Dd*/-]\\)" 1 font-lock-warning-face)
    750. 

  750.     ("^\\([?Dd-]\\)"     1 font-lock-builtin-face)
    751. 

  751.     (,nmcobol-keyword-section-names-regexp
    752. 

  752.      1 font-lock-function-name-face)
    753. 

  753.     (,(nmcobol-keyword-on-directive-line-regexp nmcobol-keywords-directives)
    754. 

  754.      1 font-lock-preprocessor-face)
    755. 

  755.     (,(nmcobol-keyword-anywhere-regexp          nmcobol-keywords-builtin)
    756. 

  756.      1 font-lock-variable-name-face)
    757. 

  757.     (,(nmcobol-keyword-special-regexp           nmcobol-keywords-statements)
    758. 

  758.      1 font-lock-keyword-face)
    759. 

  759.     (,(nmcobol-keyword-anywhere-regexp          nmcobol-keywords-std-fcns)
    760. 

  760.      1 font-lock-keyword-face)
    761. 

  761.     (,(nmcobol-keyword-anywhere-regexp (append  nmcobol-keywords-deprecated
    762. 

  762.                                                 nmcobol-keywords-privileged))
    763. 

  763.      1 font-lock-warning-face)
    764. 

  764.     (,(nmcobol-keyword-anywhere-regexp          nmcobol-keywords-reserved)
    765. 

  765.      1 font-lock-type-face)
    766. 

  766.     (,nmcobol-keyword-fcn-names-regexp
    767. 

  767.      1 font-lock-function-name-face)))
    768. 

  768. 

  769. (defvar nmcobol-font-lock-keywords ())
    770. 

  770. (defun nmcobol-build-font-lock-keywords ()
    771. 

  771.   "Creates `font-lock-keywords' based on current customize settings."
    772. 

  772.   (append nmcobol-static-font-lock-keywords
    773. 

  773.           `(,(when nmcobol-primecode-warning
    774. 

  774.                ;; ]a  ]d or ]e cannot appear in col 1-2 if using PrimeCode.
    775. 

  775.                '("^\\][ade]" . font-lock-warning-face)))))
    776. 

    777. 

  777. (defvar nmcobol-this-paren-type ()
    778. 

  778.   "Used internally by `nmcobol-font-lock-syntactic-keywords'"
    779. 

  779. )
    780. 

  780. 

  781. (defvar nmcobol-block-symbol-prefix "nmcobol-blk-typ-"
    782. 

  782.   "Paren matching symbols are built using this prefix.
    783. 

  783. You probably don't want to change it "
    784. 

  784. )
    785. 

  785. 

  786. (defcustom nmcobol-else-gets-paren-syntax t
    787. 

  787.   "When `show-paren-mode' is ON and this is nil, IF always matches END-IF only.
    788. 

  788. When this variable is non-nil, IF can match ELSE and ELSE matches END-IF."
    789. 

  789.   :type 'boolean
    790. 

  790.   :group 'nmcobol)
    791. 

    792. 

  792. (defun nmcobol-find-paren-words (lim)
    793. 

  793.   "Function to set paren syntactic properties for Cobol's block keywords.
    794. 

  794. Returns t and sets both `nmcobol-this-paren-type' and appropriate match-data
    795. 

  795. when keywords requiring paren syntax are seen within range of point & lim."
    796. 

  796.   (let ((looking t)   ;looping continues until lim or found (not looking)
    797. 

  797.         open-type               ;type of paren needed to match this open
    798. 

  798.         close-type              ;type of paren needed to match this close
    799. 

  799.         open-loc
    800. 

  800.         close-loc
    801. 

  801.         word)
    802. 

  802.     ;; walk thru each statement
    803. 

  803.     (while (and looking
    804. 

  804.                 (re-search-forward nmcobol-keywords-statements-regexp
    805. 

  805.                                    lim 'move-anyway))
    806. 

  806.       ;; Save the word and it's location in case paren class is to be applied
    807. 

  807.       (setq word (match-string-no-properties 2)
    808. 

  808.             open-loc (match-beginning 2)
    809. 

  809.             close-loc (1- (match-end 2)))
    810. 

  810.       ;; Look for the different types of paren class we might apply
    811. 

  811.       (cond
    812. 

  812.        ;; The ELSE keyword can be ignored or treated as both open and close
    813. 

  813.        ((and nmcobol-else-gets-paren-syntax (string= "ELSE" word))
    814. 

  814.         ;; The leading E of Else will match the I of IF and the trailing
    815. 

  815.         ;; E should match the F of END-IF.  When no ELSE is present the I
    816. 

  816.         ;; of IF will match the F of END-IF.
    817. 

  817.         (setq looking    nil
    818. 

  818.               word       open-loc
    819. 

  819.               open-loc   close-loc
    820. 

  820.               close-loc  word
    821. 

  821.               close-type (setq open-type
    822. 

  822.                                (intern
    823. 

  823.                                 (concat nmcobol-block-symbol-prefix "IF")))))
    824. 

    825. 

  825.        ;; close paren keywords always have close paren syntax
    826. 

  826.        ((string-match nmcobol-block-end-regexp word)
    827. 

  827.         (setq close-type
    828. 

  828.               (intern
    829. 

  829.                (concat nmcobol-block-symbol-prefix
    830. 

  830.                        (upcase (match-string-no-properties 1 word))))
    831. 

  831.               looking nil))
    832. 

    833. 

  833.        ;; 'possible' open paren keywords. More checking needed.
    834. 

  834.        ((string-match nmcobol-block-begin-regexp word)
    835. 

  835.         (let ((next (point)))
    836. 

  836.           (if (re-search-forward nmcobol-keywords-statements-regexp
    837. 

  837.                                  lim 'move-anyway)
    838. 

  838.               (setq next (match-beginning 0)))
    839. 

  839.           (goto-char open-loc)
    840. 

  840.           (if (setq open-type (nmcobol-get-block-type next))
    841. 

  841.               (setq looking nil))
    842. 

  842.           (goto-char (1+ close-loc))))))
    843. 

  843.     ;; Build the response data
    844. 

  844.     (if looking
    845. 

  845.         ;; nil is returned if no paren syntax to apply
    846. 

  846.         (set-match-data ())
    847. 

  847.       ;; both the match data and the paren type data must be set
    848. 

  848.       (set-match-data
    849. 

  849.        (append (list open-loc (1+ close-loc))
    850. 

  850.                (if open-type
    851. 

  851.                    (list open-loc (1+ open-loc))
    852. 

  852.                  (list () ()))
    853. 

  853.                (if close-type
    854. 

  854.                    (list close-loc (1+ close-loc)))))
    855. 

  855.       (setq nmcobol-this-paren-type
    856. 

  856.             (cons
    857. 

  857.              ;; declare the open-paren type
    858. 

  858.              (cons 4 open-type)
    859. 

  859.              ;; declare the close-paren type
    860. 

  860.              (cons 5 close-type)))
    861. 

  861.       ;; t must be returned iff match-data should be acted upon
    862. 

  862.       t)))
    863. 

    864. 

  864. (defvar nmcobol-font-lock-syntactic-keywords
    865. 

  865.  `(
    866. 

  866.    ;; nmcobol-find-syntactic-keywords returns matches 1&2 for comments, 3&4
    867. 

  867.    ;; for strings.  5&6 for eol terminated strings.  I must use "|"(15)
    868. 

  868.    ;; rather than "\""(7) for eol terminated strings because the begin
    869. 

  869.    ;; and end characters must be the same when "\""(7) is used.
    870. 

  870.    (nmcobol-find-syntactic-keywords (1 "<" t t)  (2 ">" t t)
    871. 

  871.                                     (3 "\"" t t) (4 "\"" t t)
    872. 

  872.                                     (5 "|" t t)  (6 "|" t t))
    873. 

  873.    ;; nmcobol-find-paren-words returns match 1 for open paren syntax and
    874. 

  874.    ;; match 2 for close paren syntax.  The car of nmcobol-this-paren-type
    875. 

  875.    ;; is used for open paren type and the cdr for close type.  The types
    876. 

  876.    ;; must be configurable due to the large number of them.
    877. 

  877.    (nmcobol-find-paren-words  (1 (car nmcobol-this-paren-type) t t)
    878. 

  878.                               (2 (cdr nmcobol-this-paren-type) t t)
    879. 

  879.    )
    880. 

  880.   )
    881. 

  881.  "A list of regexp's or functions.  Used to add syntax-table properties to
    882. 

  882. characters that can't be set by the syntax-table alone.")
    883. 

    884. 

  884. ;(defun nmcobol-start-of-statement-hook ()
    885. 

  885. ;  "Used as `font-lock-extend-region-functions' hook which see."
    886. 

  886. ;  ;; WARNING - any malfunction in this can cause emacs to enter a loop
    887. 

  887. ;  ;; that C-g will not break out of.  Your session (and all edits) will
    888. 

  888. ;  ;; be toast.
    889. 

  889. ;  ;; There seems to be no good way to suppress the warning caused by
    890. 

  890. ;  ;; accessing font-lock-beg.  It's required but apparently only
    891. 

  891. ;  ;; defined within a let statement.
    892. 

  892. ;  (goto-char font-lock-beg)
    893. 

  893. ;  (unless (bolp) (beginning-of-line))
    894. 

  894. ;  (unless (or (looking-at nmcobol-non-cobol-regexp)
    895. 

  895. ;              (looking-at nmcobol-keywords-statements-regexp))
    896. 

  896. ;      (let* ((lim (progn (nmcobol-backward-sentence 0)(point))))
    897. 

  897. ;        (goto-char font-lock-beg)
    898. 

  898. ;        (re-search-backward
    899. 

  899. ;         nmcobol-keywords-statements-regexp lim 'move-anyway)
    900. 

  900. ;        ;; If I reached the beginning of the sentence, there may be
    901. 

  901. ;        ;; comments and blank lines: they don't need refontification.
    902. 

  902. ;        (when (= (point) lim)
    903. 

  903. ;          (while (or (looking-at "^[ \t]*$")
    904. 

  904. ;                     (looking-at nmcobol-non-cobol-regexp))
    905. 

  905. ;            (forward-line)))))
    906. 

  906. ;    (unless (eq (point) font-lock-beg)
    907. 

  907. ;      (setq font-lock-beg (point))))
    908. 

  908. 

  909. (defun nmcobol-start-of-statement ()
    910. 

  910.   "Used as the syntax-begin function of `font-lock-defaults' which see."
    911. 

  911.   ;; WARNING - any malfunction in this can cause emacs to enter a loop
    912. 

  912.   ;; that C-g will not break out of.  Your session (and all edits) will
    913. 

  913.   ;; be toast.
    914. 

  914.   (unless (bolp) (beginning-of-line))
    915. 

  915.   (unless (or (looking-at nmcobol-non-cobol-regexp)
    916. 

  916.               (looking-at nmcobol-keywords-statements-regexp))
    917. 

  917.       (let* ((start (point))
    918. 

  918.              (lim (progn (nmcobol-backward-sentence 0)(point))))
    919. 

  919.         (goto-char start)
    920. 

  920.         (re-search-backward
    921. 

  921.          nmcobol-keywords-statements-regexp lim 'move-anyway)
    922. 

  922.         ;; If I reached the beginning of the sentence, there may be
    923. 

  923.         ;; comments and blank lines: they don't need refontification.
    924. 

  924.         (when (= (point) lim)
    925. 

  925.           (while (and (< (point) start)
    926. 

  926.                       (or (looking-at "^[ \t]*$")
    927. 

  927.                           (looking-at nmcobol-non-cobol-regexp)))
    928. 

  928.             (forward-line))
    929. 

  929.           (if (> (point) start)
    930. 

  930.               (goto-char start))))))
    931. 

  931. 

  932. (defun nmcobol-setup-font-lock ()
    933. 

  933.   "Sets up the buffer local value for font-lock-defaults and optionally
    934. 

  934. turns on font-lock-mode"
    935. 

  935.   ;; I use font-lock-syntactic-keywords to set some properties and I
    936. 

  936.   ;; don't want them ignored.
    937. 

  937.   (set (make-local-variable 'parse-sexp-lookup-properties) t)
    938. 

  938.   ;; I really can't imagine anyone wanting this off.
    939. 

  939.   (set (make-local-variable 'parse-sexp-ignore-comments) t)
    940. 

  940.   ;; This allows column markers to be different in separate buffers.
    941. 

  941.   (set (make-local-variable 'nmcobol-font-lock-keywords)
    942. 

  942.        (nmcobol-build-font-lock-keywords))
    943. 

  943.   ;; make sure the parsing state is reset
    944. 

  944.   (setq nmcobol-find-syntactic--state ())
    945. 

  945. ;  (setq font-lock-extend-region-functions
    946. 

  946. ;        (append font-lock-extend-region-functions
    947. 

  947. ;                '(nmcobol-start-of-statement-hook)))
    948. 

  948.   ;; This is where all the font-lock stuff actually gets set up.  Once
    949. 

  949.   ;; font-lock-defaults has it's value, setting font-lock-mode true should
    950. 

  950.   ;; cause all your syntax highlighting dreams to come true.
    951. 

  951.   (setq font-lock-defaults
    952. 

  952.          ;; The first value is all the keyword expressions.
    953. 

  953.        '(nmcobol-font-lock-keywords
    954. 

  954.          ;; keywords-only means no strings or comments get fontified
    955. 

  955.          nil
    956. 

  956.          ;; case-fold (ignore case)
    957. 

  957.          t
    958. 

  958.          ;; syntax-alist.  See also imenu-syntax-alist
    959. 

  959.          ;; This can't override syntax applied by font-lock-syntactic-keywords
    960. 

  960.          ;; It only overrides nmcobol-mode-syntax-table. 
    961. 

  961.          nil
    962. 

  962.          ;; syntax-begin - function to move outside syntactic block
    963. 

  963.          ;; This doesn't work for some reason.  I'm using the hook
    964. 

  964.          ;; font-lock-extend-region-functions for this.
    965. 

  965.          nil ; nmcobol-start-of-statement
    966. 

  966.          ;; font-lock-syntactic-keywords
    967. 

  967.          ;; takes (matcher (match syntax override lexmatch) ...)...
    968. 

  968.          (font-lock-syntactic-keywords . nmcobol-font-lock-syntactic-keywords)))
    969. 

  969.   ; font lock is turned on by default in this mode. Use customize to disable.
    970. 

  970.   (when nmcobol-font-lock-always (font-lock-mode t)))
    971. 

  971. 

  972. ;;; Static Column Markers
    973. 

  973. 

  974. (defcustom nmcobol-column-marker-1 79
    975. 

  975.   "*Turns on column-marker-1 (which see) at the specified column.
    976. 

  976. Use of this feature requires the column-marker.el package be loaded or on
    977. 

  977. the search list."
    978. 

  978.   :type 'integer
    979. 

  979.   :group 'nmcobol)
    980. 

  980. (make-variable-buffer-local 'nmcobol-column-marker-1)
    981. 

    982. 

  982. (defcustom nmcobol-column-marker-2 0
    983. 

  983.   "*Turns on column-marker-2 (which see) at the specified column.
    984. 

  984. Use of this feature requires the column-marker.el package."
    985. 

  985.   :type 'integer
    986. 

  986.   :group 'nmcobol)
    987. 

  987. (make-variable-buffer-local 'nmcobol-column-marker-2)
    988. 

    989. 

  989. (defun nmcobol-setup-column-markers ()
    990. 

  990.   "Turns on column markers if configured and available.
    991. 

  991. See `nmcobol-column-marker-1' and `nmcobol-column-marker-2' "
    992. 

  992.   (if (not (condition-case () (require 'column-marker) (error nil)))
    993. 

  993.       (if (not (and (zerop nmcobol-column-marker-1)
    994. 

  994.                     (zerop nmcobol-column-marker-2)))
    995. 

  995.           (message "column markers are configured but %s"
    996. 

  996.                    " column-marker feature not available."))
    997. 

  997.     (setq indent-tabs-mode nil)      ;documented as buffer local
    998. 

  998.     (column-marker-1 nmcobol-column-marker-1)
    999. 

  999.     (column-marker-2 nmcobol-column-marker-2)))
    1000. 

  1000. 

  1001. ;;; Imenu & Which-function
    1002. 

  1002. 

  1003. (defcustom nmcobol-imenu-menubar t
    1004. 

  1004.   "If not nil, `imenu-add-to-menubar' is called during mode initialization.
    1005. 

  1005. This adds a [Menu name] menu to your menu bar.  By default the menu
    1006. 

  1006. contains a list of all procedures, sections and pages in your program.
    1007. 

  1007. You can go directly to any item on the menu by selecting it.  You can
    1008. 

  1008. control what appears on this menu by modifying
    1009. 

  1009. `nmcobol-imenu-expression-alist'.  You must turn imenu on for this to
    1010. 

  1010. work.  See `imenu' in the Emacs reference manual for more information.
    1011. 

  1011. Personally I recommend customizing `imenu-sort-function' to sort by
    1012. 

  1012. name."
    1013. 

  1013.   :type  '(choice :tag "Menu Name"
    1014. 

  1014.                   (string :tag "Menu Name")
    1015. 

  1015.                   (const :tag "Index" t)
    1016. 

  1016.                   (const :tag "None" nil))
    1017. 

  1017.   :group 'nmcobol)
    1018. 

    1019. 

  1019. (defvar nmcobol-imenu-syntax-alist ()
    1020. 

  1020.   "Overrides to `nmcobol-mode-syntax-table' used during `imenu-generic-expression' search."
    1021. 

  1021.   ;;AFAIK there are no character adjustments needed during imenu search.
    1022. 

  1022. )
    1023. 

  1023. 

  1024. (defcustom nmcobol-imenu-fcn-names-regexp
    1025. 

  1025.   "^[ \t]\\{1,3\\}\\(\\w+\\([^T]\\|[^I]T\\|[^X]IT\\|[^E]XIT\\|[^-]EXIT\\)\\)[ \t]*\\."
    1026. 

  1026.   "Defines a regexp that finds the names of paragraphs.
    1027. 

  1027. Used to build the `imenu' index."
    1028. 

  1028.   :type  'regexp
    1029. 

  1029.   :group 'nmcobol)
    1030. 

    1031. 

  1031. (defcustom nmcobol-imenu-expression-alist
    1032. 

  1032.   `((nil                   ,nmcobol-imenu-fcn-names-regexp       1)
    1033. 

  1033.     ("Divisions/Sections"  ,nmcobol-keyword-section-names-regexp 1)
    1034. 

  1034.     ("?Sections"           "^\\?section\\s-+\\(\\w+\\)\\b"       1)
    1035. 

  1035.     ("?Pages"              "^\\?page\\s-+\"\\s-*\\(.+?\\)\""     1))
    1036. 

  1036.   "A list of regular expressions for creating an `imenu' index.
    1037. 

    1038. 

  1038. Each element has the form (list-name regexp num).
    1039. 

  1039. 

  1040. Where list-name is the name of the submenu under which items matching regexp
    1041. 

  1041. are found and num is the expression index defining the label to use for the
    1042. 

  1042. submenu entry.  When num = 0 the entire matching regexp text appears under
    1043. 

  1043. list-name.  When list-name is nil the matching entries appear in the root
    1044. 

  1044. imenu list rather than in a submenu.  See also `nmcobol-imenu-menubar'"
    1045. 

  1045.   :type '(repeat (list (choice :tag "Submenu Name" string (const nil))
    1046. 

  1046.                        regexp (integer :tag "Regexp index")))
    1047. 

  1047.   :group 'nmcobol)
    1048. 

    1049. 

  1049. (defcustom nmcobol-display-which-function t
    1050. 

  1050.   "This option turns `which-func' on for all `nmcobol-mode' buffers.
    1051. 

  1051. `which-func' is a package that causes the current function, section or
    1052. 

  1052. page to be displayed on the mode line.  `which-func' uses `imenu'.  Also
    1053. 

  1053. see `nmcobol-imenu-expression-alist' for more information."
    1054. 

  1054.   :type 'boolean
    1055. 

  1055.   :group 'nmcobol)
    1056. 

    1057. 

  1057. (defun nmcobol-setup-imenu ()
    1058. 

  1058.   "Installs nmcobol-imenu-generic-expression & nmcobol-imenu-syntax-alist."
    1059. 

  1059.   ;; imenu doc says these 3 are buffer-local by default
    1060. 

  1060.   (setq imenu-generic-expression nmcobol-imenu-expression-alist)
    1061. 

  1061.   (setq imenu-syntax-alist nmcobol-imenu-syntax-alist)
    1062. 

  1062.   (setq imenu-case-fold-search t) ;NMCOBOL are never case sensitive
    1063. 

  1063.   (when nmcobol-imenu-menubar
    1064. 

  1064.     (if (condition-case ()
    1065. 

  1065.             (progn (require 'imenu) t)
    1066. 

  1066.           (error nil))
    1067. 

  1067.         (imenu-add-menubar-index)
    1068. 

  1068.       (message "nmcobol-imenu-menubar is set but imenu feature not available.")))
    1069. 

  1069.   (when nmcobol-display-which-function
    1070. 

  1070.     (if (condition-case ()
    1071. 

  1071.             (progn (require 'which-func) t)
    1072. 

  1072.           (error nil))
    1073. 

  1073.         (which-function-mode t)
    1074. 

  1074.       (message "nmcobol-display-which-function set but which-func not available"))))
    1075. 

    1076. 

  1076. ;;; Adaptive-fill / auto-fill (needs much work but it's a start)
    1077. 

    1078. 

  1078. (defcustom nmcobol-restrict-auto-fill t
    1079. 

  1079.   "When not nil a buffer local value for `fill-nobreak-predicate' is created
    1080. 

  1080. to prevent code from being accidentally realligned.  The function uses syntax
    1081. 

  1081. highlighting to detect comments so `font-lock-mode' must be enabled to work."
    1082. 

  1082.   :type 'boolean
    1083. 

  1083.   :group 'nmcobol)
    1084. 

    1085. 

  1085. (defun nmcobol-setup-adaptive-fill ()
    1086. 

  1086.   "Sets up the NMCOBOL-MODE adaptive-fill variables.  DOESN'T WORK!"
    1087. 

  1087. ;; All of this section is left over from TAL mode !needs attention!
    1088. 

  1088.   (set (make-local-variable 'fill-individual-varying-indent)
    1089. 

  1089.        nil)
    1090. 

  1090.   (set (make-local-variable 'auto-fill-inhibit-regexp)
    1091. 

  1091.        "\\s-*[^*/]")
    1092. 

  1092.   (set (make-local-variable 'comment-use-syntax)
    1093. 

  1093.        t)
    1094. 

  1094.   (set (make-local-variable 'comment-start)
    1095. 

  1095.        "*")
    1096. 

  1096.   (set (make-local-variable 'comment-end)
    1097. 

  1097.        "")
    1098. 

  1098.   (set (make-local-variable 'comment-padding)
    1099. 

  1099.        " ")
    1100. 

  1100.   (set (make-local-variable 'comment-start-skip)
    1101. 

  1101.        "\\(\\s<\\|*\\)\\s-*")
    1102. 

  1102.   (set (make-local-variable 'sentence-end)
    1103. 

  1103.        "\\(;\\|\\.[ \t\n\f]\\)")
    1104. 

  1104.   (set (make-local-variable 'paragraph-start)
    1105. 

  1105.        "\\( +[0-9]\\| +\\w+\\( +\\(division\\(\\s-+using\\s-+[^.\n]+\\)?\\|section\\)\\) *\\.\\)")
    1106. 

  1106.   (set (make-local-variable 'paragraph-separate)
    1107. 

  1107.        "\n")
    1108. 

  1108.   (set (make-local-variable 'adaptive-fill-regexp)
    1109. 

  1109.        "^\\s-*\\(!\\|--\\)[~%^&()_#[*|;:-=+]*\\s-*")
    1110. 

  1110.   (set (make-local-variable 'adaptive-fill-first-line-regexp)
    1111. 

  1111.        adaptive-fill-regexp)
    1112. 

  1112.   (when nmcobol-restrict-auto-fill
    1113. 

  1113.     ; This is supposed to restrict auto-fill to comments only
    1114. 

  1114.     (fset (make-local-variable 'fill-nobreak-predicate)
    1115. 

  1115.           (lambda ()
    1116. 

  1116.             (not (eq (get-text-property (point) 'face)
    1117. 

  1117.                      'font-lock-comment-face))))))
    1118. 

    1119. 

  1119. ;;; Indentation
    1120. 

    1121. 

  1121. (defcustom nmcobol-righthand-keyword-column nil
    1122. 

  1122.   "The column to which `nmcobol-secondary-indent-words' are indented.
    1123. 

  1123. 38 is the default for DDL output so that value is mirrored here.
    1124. 

  1124. Setting this to nil prevents secondary indentation."
    1125. 

  1125.   :type '(choice (integer :tag "Indent column")
    1126. 

  1126.                  (const   :tag "Don't indent" nil))
    1127. 

  1127.   :group 'nmcobol)
    1128. 

  1128. (make-variable-buffer-local 'nmcobol-righthand-keyword-column)
    1129. 

    1130. 

  1130. (defcustom nmcobol-secondary-indent-words
    1131. 

  1131.   '("BY" "DELIMITED" "FROM" "GIVING" "IS" "OF" "PIC"
    1132. 

  1132.     "SHARED" "TO" "USING" "VALUE" "WITH")
    1133. 

  1133.   "List of keywords to be indented to `nmcobol-righthand-keyword-column' col."
    1134. 

  1134.   :type '(repeat (string :tag "word"))
    1135. 

  1135.   :group 'nmcobol
    1136. 

  1136. )
    1137. 

  1137. 

  1138. (defun nmcobol-char-maybe-comment (arg)
    1139. 

  1139.   "Removes leading white space if character is preceeded only by white space.
    1140. 

  1140. The behavior can be circumvented with C-u.
    1141. 

  1141. A numeric prefix does not prevent the removal of white space."
    1142. 

  1142.   (interactive "*P")
    1143. 

  1143.   (if (and (looking-back "^[ \t]*")
    1144. 

  1144.            (or (null arg)
    1145. 

  1145.                (numberp arg)))
    1146. 

  1146.       (progn
    1147. 

  1147.         (replace-match "")
    1148. 

  1148.         (self-insert-command (prefix-numeric-value arg))
    1149. 

  1149.         (if (null arg)(indent-relative t)))
    1150. 

  1150.     (self-insert-command (if (numberp arg)(prefix-numeric-value arg) 1))))
    1151. 

  1151. 

  1152. (defun nmcobol-indent-region (&optional beg end)
    1153. 

  1153.   "Indents all lines even partly within the selected region.
    1154. 

  1154. If BEG/END are nil, indent the current line."
    1155. 

  1155.   (interactive)
    1156. 

  1156.   (if (and (null beg) transient-mark-mode mark-active)
    1157. 

  1157.       (setq beg (min (point)(mark))
    1158. 

  1158.             end (max (point)(mark))
    1159. 

  1159.             deactivate-mark t))
    1160. 

  1160.   (if (equal beg end)
    1161. 

  1161.       (nmcobol-indent-line)
    1162. 

  1162.     (setq end (set-marker (make-marker) end))
    1163. 

  1163.     (goto-char beg)
    1164. 

  1164.     (while (< (point) end)
    1165. 

  1165.       (nmcobol-indent-line t)
    1166. 

  1166.       (forward-line))
    1167. 

  1167.     (goto-char end)
    1168. 

  1168.     (set-marker end nil)))
    1169. 

  1169. 

  1170. (defun nmcobol-re-search-for-keyword (regexp bound)
    1171. 

  1171.   "Like re-search-forward but only program lines are examined.
    1172. 

  1172. Matches within quoted strings are also ignored.
    1173. 

  1173. Obviously REGEXP can't span lines."
    1174. 

  1174.   (while (and (> bound (point))
    1175. 

  1175.               (or (looking-at nmcobol-non-cobol-regexp)
    1176. 

  1176.                   (not (re-search-forward regexp (line-end-position) t))
    1177. 

  1177.                   (eq (get-text-property (match-beginning 0) 'face)
    1178. 

  1178.                       'font-lock-string-face)))
    1179. 

  1179.     (forward-line))
    1180. 

  1180.   (< (point) bound))
    1181. 

  1181. 

  1182. (defun nmcobol-get-block-type (next)
    1183. 

  1183.   "Returns a value indicating the type of block at point.  Nil if none.
    1184. 

  1184. NEXT is the buffer position of the next COBOL statement.  The search for
    1185. 

  1185. keywords that determine if this statement starts a block, ends at NEXT.
    1186. 

  1186. Point is left where the search ended."
    1187. 

  1187.   (if (looking-at nmcobol-block-always-regexp)
    1188. 

  1188.       (intern (concat nmcobol-block-symbol-prefix
    1189. 

  1189.                       (match-string-no-properties 1)))
    1190. 

  1190.     (let ((loc (point))
    1191. 

  1191.           sym)
    1192. 

  1192.       (cond
    1193. 

  1193.        ((looking-at "PERFORM\\s-+")
    1194. 

  1194.         (goto-char (match-end 0))
    1195. 

  1195.         (if (or (looking-at nmcobol-keywords-imperatives-regexp)
    1196. 

  1196.                 (looking-at "\\(\\s_\\|\\w\\)+\\s-+TIMES\\_>")
    1197. 

  1197.                 (looking-at "\\(WITH\\|TEST\\|UNTIL\\|VARYING\\)\\_>"))
    1198. 

  1198.             (setq sym (intern (concat nmcobol-block-symbol-prefix
    1199. 

  1199.                                       "PERFORM")))))
    1200. 

  1200.        
    1201. 

  1201.        ((looking-at "\\(ADD\\|COMPUTE\\|DIVIDE\\|MULTIPLY\\|SUBTRACT\\)\\_>")
    1202. 

  1202.         (setq sym (intern (concat nmcobol-block-symbol-prefix
    1203. 

  1203.                                   (match-string-no-properties 0))))
    1204. 

  1204.         (goto-char (match-end 0))
    1205. 

  1205.         ;; Look for the ON ERROR clause
    1206. 

  1206.         (unless (nmcobol-re-search-for-keyword "\\s-ERROR\\_>" next)
    1207. 

  1207.           (setq sym ())))
    1208. 

  1208.        
    1209. 

  1209.        ((looking-at "\\(READ\\|START\\|DELETE\\|DELETE\\|REWRITE\\)\\_>")
    1210. 

  1210.         (setq sym (intern (concat nmcobol-block-symbol-prefix
    1211. 

  1211.                                   (match-string-no-properties 0))))
    1212. 

  1212.         (goto-char (match-end 0))
    1213. 

  1213.         ;; Look for the [NOT] AT END or INVALID KEY clause
    1214. 

  1214.         (unless (nmcobol-re-search-for-keyword "\\s-\\(END\\|INVALID\\)\\_>"
    1215. 

  1215.                                                next)
    1216. 

  1216.           (setq sym ())))
    1217. 

  1217.        
    1218. 

  1218.        ((looking-at "\\(UNSTRING\\|STRING\\)\\_>")
    1219. 

  1219.        (setq sym (intern (concat nmcobol-block-symbol-prefix
    1220. 

  1220.                                  (match-string-no-properties 0))))
    1221. 

  1221.        (goto-char (match-end 0))
    1222. 

  1222.        ;; Look for the [NOT] ON OVERFLOW clause
    1223. 

  1223.        (unless (nmcobol-re-search-for-keyword "\\s-OVERFLOW\\_>" next)
    1224. 

  1224.          (setq sym ())))
    1225. 

  1225.        
    1226. 

  1226.        ((looking-at "WRITE\\_>")
    1227. 

  1227.         (setq sym (intern (concat nmcobol-block-symbol-prefix
    1228. 

  1228.                                   (match-string-no-properties 0))))
    1229. 

  1229.         (goto-char (match-end 0))
    1230. 

  1230.         ;; Look for EOP, END-OF-PAGE, or [NOT] INVALID KEY clauses
    1231. 

  1231.         (unless (nmcobol-re-search-for-keyword
    1232. 

  1232.                  "\\s-\\(EOP\\|END-OF-PAGE\\|INVALID\\)\\_>" next)
    1233. 

  1233.           (setq sym ()))))
    1234. 

  1234.       (goto-char loc)
    1235. 

  1235.       sym)))
    1236. 

  1236. 

  1237. (defun nmcobol-indent-line (&optional batch-mode)
    1238. 

  1238.   "Indents the current NMCOBOL line appropriately for it's context.
    1239. 

  1239. BATCH-MODE is used by `nmcobol-indent-region' to prevent buffer
    1240. 

  1240. modifications that only consist of blanks in otherwise empty lines
    1241. 

  1241. and to prevent arithmetic operations involving * or / from being
    1242. 

  1242. converted to comment lines accidentally."
    1243. 

  1243.   (save-match-data
    1244. 

  1244.     (let* (nmcobol-sentence-includes-comments
    1245. 

  1245.            (loc (point-marker))         ;marker of starting cursor
    1246. 

  1246.            (col (current-column))       ;cursor's starting column
    1247. 

  1247.            (bol (progn (beginning-of-line)(point))) ;beginning of line loc
    1248. 

  1248.            (cur (prog2 (skip-chars-forward " \t") ;current indent amount
    1249. 

  1249.                     (current-column)
    1250. 

  1250.                   (goto-char bol))))
    1251. 

  1251.       ;; I'm at the beginning of the line to indent - do it
    1252. 

  1252.       (cond
    1253. 

  1253.        ;; Don't move lines starting like this
    1254. 

  1254.        ((looking-at "[-?/*dD]")
    1255. 

  1255.         ;(message "dont move")
    1256. 

  1256.         (goto-char loc)
    1257. 

  1257.         (set-marker loc nil))
    1258. 

    1259. 

  1259.        ;; Non-code lines all start in column 0
    1260. 

  1260.        ((and (not batch-mode)(looking-at "\\([ \t]+\\)[?/*]"))
    1261. 

  1261.         ;(message "col 0")
    1262. 

  1262.         (replace-match "" nil nil nil 1)
    1263. 

  1263.         (goto-char loc)
    1264. 

  1264.         (set-marker loc nil))
    1265. 

    1266. 

  1266.        ;; Blank lines start where prior line left off or column 1 if none
    1267. 

  1267.        ((looking-at "[ \t]*\n")
    1268. 

  1268.         ;(message "relative")
    1269. 

  1269.         (set-marker loc nil)
    1270. 

  1270.         (if batch-mode ()  ;don't indent blank lines if flag non-nil
    1271. 

  1271.           (let ((indent (save-excursion
    1272. 

  1272.                           (if (re-search-backward "^[ \t]+[^ \t\n]" nil t)
    1273. 

  1273.                               (skip-chars-forward " \t" (line-end-position))
    1274. 

  1274.                             1))))
    1275. 

  1275.             (end-of-line)
    1276. 

  1276.             (let ((cc (- indent (current-column))))
    1277. 

  1277.               (if (> 0 cc)               ;Move backward needed
    1278. 

  1278.                   (backward-delete-char-untabify (- cc))
    1279. 

  1279.                 (indent-to indent))))))
    1280. 

    1281. 

  1281.        ;; Period only lines are like new sentences within a paragraph
    1282. 

  1282.        ((looking-at "[ \t]*\\.")
    1283. 

  1283.         ;(message "period")
    1284. 

  1284.         (goto-char loc)
    1285. 

  1285.         (set-marker loc nil)
    1286. 

  1286.         (unless (= 4 cur)
    1287. 

  1287.           (replace-match "    ." nil nil nil 0)))
    1288. 

    1289. 

  1289.        ;; This is the messy part - find out what kind of line this is
    1290. 

  1290.         (t
    1291. 

  1291.          (let* ((typ (nmcobol-beginning-of-sentence)) ; Get sentence type
    1292. 

  1292.                 (sos (point))                         ; start of sentence loc
    1293. 

  1293.                 (indent 4)                            ; default sentence start
    1294. 

  1294.                 extra                   ; add to indent in special cases
    1295. 

  1295.                 prior-typ)
    1296. 

    1297. 

  1297.             (if (= bol (point))
    1298. 

  1298.                 ;; This is the beginning of a new sentence of type typ
    1299. 

  1299.                 (cond
    1300. 

  1300.                   ((numberp typ)        ;it's a numbered sentence
    1301. 

    1302. 

  1302.                    ;(message "number")
    1303. 

  1303.                    (if (or (= 0 typ)(= 1 typ)(= 66 typ)(= 77 typ))
    1304. 

  1304.                        ;; These numbers are top level
    1305. 

  1305.                        (setq indent 1)
    1306. 

    1307. 

  1307.                      ;; Other numbers are relative to prior sentence.
    1308. 

  1308.                      (nmcobol-backward-sentence 1)
    1309. 

  1309.                      (setq prior-typ (nmcobol-beginning-of-sentence)
    1310. 

  1310.                            indent (if (looking-at "[ \t]+")
    1311. 

  1311.                                       (prog2 (goto-char (match-end 0))
    1312. 

  1312.                                              (current-column)
    1313. 

  1313.                                              (beginning-of-line))
    1314. 

  1314.                                     0)
    1315. 

  1315.                            extra (if (looking-at "[ \t]+[0-9]\\{1,2\\}[ \t]+")
    1316. 

  1316.                                      (prog2 (goto-char (match-end 0))
    1317. 

  1317.                                          (- (current-column) indent)
    1318. 

  1318.                                        (beginning-of-line))))
    1319. 

  1319.                      (cond
    1320. 

  1320.                       ;; Error case. Prior statement isn't numbered
    1321. 

  1321.                       ((not (numberp prior-typ))
    1322. 

  1322.                        ;(message "number - prior non")
    1323. 

  1323.                        (setq indent (+ indent 3)))
    1324. 

    1325. 

  1325.                       ;; Prior statement is same level. Use same indent.
    1326. 

  1326.                       ((= prior-typ typ)
    1327. 

  1327.                        ;(message "number - prior same")
    1328. 

  1328.                       )
    1329. 

    1330. 

  1330.                       ;; Current is subordinate to prior, indent deeper
    1331. 

  1331.                       ((> typ prior-typ)
    1332. 

  1332.                        ;(message "number - prior superior")
    1333. 

  1333.                        (setq indent (+ indent (or extra 3))))
    1334. 

    1335. 

  1335.                        ;; Prior statement is inferior to current
    1336. 

  1336.                       (t
    1337. 

  1337.                        ;(message "number - search for superior")
    1338. 

  1338.                        ;; find equal or superior statement
    1339. 

  1339.                        (while (and (= 0 (nmcobol-backward-sentence 1))
    1340. 

  1340.                                    (setq prior-typ
    1341. 

  1341.                                          (nmcobol-beginning-of-sentence))
    1342. 

  1342.                                    (numberp prior-typ)
    1343. 

  1343.                                    (< typ prior-typ)))
    1344. 

  1344.                        ;; That statement's indentation is what I'll use
    1345. 

  1345.                        (beginning-of-line) ; can't necessarily assume this.
    1346. 

  1346.                        (setq indent (if (looking-at "[ \t]+")
    1347. 

  1347.                                         (prog2 (goto-char (match-end 0))
    1348. 

  1348.                                             (current-column)
    1349. 

  1349.                                           (beginning-of-line))
    1350. 

  1350.                                       0)
    1351. 

  1351.                              extra (if (looking-at "[ \t]+[0-9]\\{1,2\\}[ \t]+")
    1352. 

  1352.                                        (prog2 (goto-char (match-end 0))
    1353. 

  1353.                                            (- (current-column) indent)
    1354. 

  1354.                                          (beginning-of-line))))
    1355. 

  1355.                        (unless (and (numberp prior-typ)
    1356. 

  1356.                                     (= prior-typ typ))
    1357. 

  1357.                          (setq indent (+ (or extra 3) indent)))))))
    1358. 

    1359. 

  1359.                   ;; Beginning of a special but non-numbered sentence.
    1360. 

  1360.                   ((stringp typ)
    1361. 

  1361.                    ;(message "special statement")
    1362. 

  1362.                    (setq indent 1))
    1363. 

    1364. 

  1364.                   (t              ;typ is nil - start of regular sentence
    1365. 

  1365.                    ;(message "Normal sentence start")
    1366. 

  1366.                    (setq indent 4))    ;should already be set to this...?
    1367. 

  1367.                 )
    1368. 

    1369. 

  1369.               ;; Context is amid sentence.  See if it's amid a statement.
    1370. 

  1370.               (goto-char bol)
    1371. 

  1371.               (if (looking-at nmcobol-keywords-statements-regexp)
    1372. 

  1372.                   ;; Lines starting with a statement keyword indent like the
    1373. 

  1373.                   ;; last statement unless the last statement begins a block
    1374. 

  1374.                   ;; or the current statement ends a block.
    1375. 

  1375.                   (progn
    1376. 

  1376.                     ;; Get the type of statement being indented.
    1377. 

  1377.                     (setq typ (upcase (match-string-no-properties 2)))
    1378. 

  1378.                     ;(message "amid - new statement")
    1379. 

  1379.                     ;; find start of last statement & get it's indentation
    1380. 

  1380.                     (re-search-backward
    1381. 

  1381.                      nmcobol-keywords-statements-regexp sos 'move-anyway)
    1382. 

  1382.                     (setq prior-typ (upcase (or (match-string-no-properties 2)
    1383. 

  1383.                                                 "")))
    1384. 

  1384.                     (skip-chars-forward " \t")
    1385. 

  1385.                     (setq indent (current-column))
    1386. 

  1386.                     ;; if prior statement is a block begin, indent from it
    1387. 

  1387.                     (if (setq extra (nmcobol-get-block-type bol))
    1388. 

  1388.                         (setq indent (+ indent 3)))
    1389. 

  1389.                     ;; if current line is a block end, indentation decreases
    1390. 

  1390.                     ;; unless it ends a statement that didn't require an end.
    1391. 

  1391.                     (when
    1392. 

  1392.                         (or
    1393. 

  1393.                          (string-match nmcobol-block-end-regexp typ)
    1394. 

  1394.                          (string-match "\\(WHEN\\|ELSE\\|THEN\\)" typ))
    1395. 

  1395.                       (unless (and
    1396. 

  1396.                                (not extra)
    1397. 

  1397.                                (string= prior-typ
    1398. 

  1398.                                         (upcase
    1399. 

  1399.                                          (match-string-no-properties 1 typ))))
    1400. 

  1400.                         (setq indent (- indent 3)))))
    1401. 

    1402. 

  1402.                 ;; line must be continuation of some statement
    1403. 

  1403.                 ;(message "amid a statement")
    1404. 

  1404.                 (if (re-search-backward
    1405. 

  1405.                      nmcobol-keywords-statements-regexp sos 'move-anyway)
    1406. 

  1406.                     (progn (goto-char (match-end 1))
    1407. 

  1407.                            (setq prior-typ (match-string-no-properties 2)
    1408. 

  1408.                                  indent (current-column)))
    1409. 

  1409.                   (skip-chars-forward " \t" (line-end-position))
    1410. 

  1410.                   (setq prior-typ ""
    1411. 

  1411.                         indent (current-column)))
    1412. 

  1412.                 (setq indent (+ 6 indent)))
    1413. 

  1413.               (setq typ nil))
    1414. 

  1414.             ;(message "typ = %s Cur = %s, new = %s" typ cur indent)
    1415. 

  1415.             ;; Unless it's a special type (typ) it shouldn't be indenting
    1416. 

  1416.             ;; less than 4 so flag an error by removing all indentation
    1417. 

  1417.             (if (and (not typ)
    1418. 

  1418.                      (< indent 4))
    1419. 

  1419.                 (setq indent 0))
    1420. 

  1420.             (unless (= indent cur) ;current line is already indented correctly
    1421. 

  1421.               (goto-char bol)
    1422. 

  1422.               (looking-at "[ \t]*")
    1423. 

  1423.               (replace-match (make-string indent ? ) nil nil nil 0))
    1424. 

  1424.             (goto-char loc)
    1425. 

  1425.             (set-marker loc nil)
    1426. 

  1426.             (if (and (< 0 col)(> indent (current-column)))
    1427. 

  1427.                 (move-to-column indent)))))))
    1428. 

  1428.   (nmcobol-secondary-indent nmcobol-righthand-keyword-column nil))
    1429. 

    1430. 

  1430. (defun nmcobol-secondary-indent (to-col right)
    1431. 

  1431.   "Indents `nmcobol-secondary-indent-words' on the current line to TO-COL.
    1432. 

  1432. RIGHT indicates if the left or right hand side of the word is indented to
    1433. 

  1433. that column.  nil means align the left hand side, any other value
    1434. 

  1434. indicates the right side.  If TO-COL is unreasonable (not between 20 and
    1435. 

  1435. 120) the routine does nothing.  Comment and compiler directive lines are
    1436. 

  1436. always ignored."
    1437. 

  1437.   (when (and to-col (> to-col 20)(< to-col 120))
    1438. 

  1438.     (let ((start (point-marker))
    1439. 

  1439.           (end (line-end-position))
    1440. 

  1440.           (regexp (concat "\\_<"
    1441. 

  1441.                           (regexp-opt nmcobol-secondary-indent-words t)
    1442. 

  1442.                           "\\_>"))
    1443. 

  1443.           col)
    1444. 

  1444.       (beginning-of-line)
    1445. 

  1445.       (when (and (not (looking-at nmcobol-non-cobol-regexp))
    1446. 

  1446.                  (re-search-forward regexp end t)
    1447. 

  1447.                  (not (eq 'font-lock-string-face
    1448. 

  1448.                           (get-text-property (point) 'face))))
    1449. 

  1449.         (if right
    1450. 

  1450.             (progn
    1451. 

  1451.               (setq col (- to-col (current-column)))
    1452. 

  1452.               (goto-char (match-beginning 1)))
    1453. 

  1453.           (goto-char (match-beginning 1))
    1454. 

  1454.           (setq col (- to-col (current-column))))
    1455. 

  1455.         (unless (looking-back "^\\s-+")
    1456. 

  1456.           (cond
    1457. 

  1457.            ((< 0 col)
    1458. 

  1458.             (insert (make-string col ? )))
    1459. 

  1459.            ((> 0 col)
    1460. 

  1460.             (while (and (> 0 col)
    1461. 

  1461.                         (looking-back "\\s-\\s-"))
    1462. 

  1462.               (backward-delete-char-untabify 1)
    1463. 

  1463.               (setq col (1+ col)))))))
    1464. 

  1464.       (goto-char start))))
    1465. 

  1465. 

  1466. (defun nmcobol-setup-indent ()
    1467. 

  1467.   "Sets default indentation or sets up nmcobol-indent if available."
    1468. 

  1468. ;  (if (condition-case ()
    1469. 

  1469. ;          (progn (require 'nmcobol-indent) t)
    1470. 

  1470. ;        (error nil))
    1471. 

  1471.   (setq indent-line-function 'nmcobol-indent-region
    1472. 

  1472.         indent-region-function 'nmcobol-indent-region))
    1473. 

    1474. 

  1474. ;    (set (make-local-variable 'indent-line-function) 'indent-relative-maybe)))
    1475. 

  1475. 

  1476. ;;; Language Skeletons -- Feel free to add more of your own!
    1477. 

  1477. 

  1478. (defcustom nmcobol-keywords-case 'upper
    1479. 

  1479.   "*Indicates if keywords in skeletons should be all UPPER CASE, all lower
    1480. 

  1480. case or Camel Case (First Char Upper & Rest Lower)."
    1481. 

  1481.   :type  '(choice :tag "Skeleton Case"
    1482. 

  1482.                   (const :tag "ALL CAPS"    upper)
    1483. 

  1483.                   (const :tag "all small"   lower)
    1484. 

  1484.                   (const :tag "Camel Case"  camel)
    1485. 

  1485.                   (const :tag "DON'T Change"  ()))
    1486. 

  1486.   :group 'nmcobol)
    1487. 

    1488. 

  1488. (defun nmcobol-setup-skel ()
    1489. 

  1489.   "Configures skeleton.el functions for the NMCOBOL environemnt."
    1490. 

  1490.   (set (make-local-variable 'skeleton-transformation) 'nmcobol-skel-transform)
    1491. 

  1491.   ;; This prevents abbrevs from expanding within skeletons
    1492. 

  1492.   (setq skeleton-further-elements '((abbrev-mode nil))))
    1493. 

    1494. 

  1494. (defun nmcobol-skel-transform ( element )
    1495. 

  1495.   "Called by `skeleton-insert'.  Gives ELEMENT `nmcobol-keywords-case' capitalization."
    1496. 

  1496.   ;; This should be made more complex to only change the case of certain words
    1497. 

  1497.   ;; so the user can create skeletons containing items that should not be
    1498. 

  1498.   ;; affected by nmcobol-keywords-case.  There are 3 obvious ways.  1) use the
    1499. 

  1499.   ;; keywords tables above. 2) add a customize to ignore words. 3) add a
    1500. 

  1500.   ;; customize to specify specific words to be affected.  Preferences?
    1501. 

  1501.   (if (stringp element)
    1502. 

  1502.     (cond
    1503. 

  1503.      ((eq nmcobol-keywords-case 'upper) (upcase element))
    1504. 

  1504.      ((eq nmcobol-keywords-case 'lower) (downcase element))
    1505. 

  1505.      ((eq nmcobol-keywords-case 'camel) (capitalize element))
    1506. 

  1506.      ( t                             element            ))
    1507. 

  1507.     element))
    1508. 

  1508. 

  1509. (defun nmcobol-set-line-syntax ()
    1510. 

  1510.   "Applies font-lock-syntactic-keywords to current line.
    1511. 

  1511. Used to set properties necessary for proper indentation."
    1512. 

  1512.   (if font-lock-mode
    1513. 

  1513.       (save-excursion    ; next stmt moves point.
    1514. 

  1514.         (font-lock-fontify-syntactic-keywords-region
    1515. 

  1515.          (line-beginning-position) (line-end-position))
    1516. 

  1516.         ()     ;any result is inserted into buffer
    1517. 

  1517.       )))
    1518. 

  1518. 

  1519. (define-skeleton nmcobol-if-skel
    1520. 

  1520.   "This is an example skeleton."
    1521. 

  1521.   nil
    1522. 

  1522.   " IF" > " " -                                \n
    1523. 

  1523.   _ | \n
    1524. 

  1524.   " END-IF"       (nmcobol-set-line-syntax)  > \n)
    1525. 

  1525. 

  1526. (define-skeleton nmcobol-paragraph-skel
    1527. 

  1527.   "Inserts comment bars to surround a new paragraph name."
    1528. 

  1528.   nil \n
    1529. 

  1529.   "********************************"        > \n
    1530. 

  1530.   " 0." > -1 _ "."                            \n
    1531. 

  1531.   "********************************"        > \n \n
    1532. 

  1532.   "."                                       > \n \n)
    1533. 

  1533. 

  1534. 

  1535. ;;; Abbrev support
    1536. 

  1536. 

  1537. (defcustom nmcobol-abbrev-mode t
    1538. 

  1538.   "Sets the default value for `abbrev-mode' upon entry into `nmcobol-mode'."
    1539. 

  1539.   :type 'boolean
    1540. 

  1540.   :group 'nmcobol)
    1541. 

    1542. 

  1542. (defvar nmcobol-mode-abbrev-table-list
    1543. 

  1543.   '(("$i" "" nmcobol-if-skel)
    1544. 

  1544.     ("$p" "" nmcobol-paragraph-skel))
    1545. 

  1545.   "List of pre-defined `nmcobol-mode' abbrev definitions.
    1546. 

  1546. Use \\[list-abbrevs] to see all defined abbrevs.")
    1547. 

    1548. 

  1548. (defvar nmcobol-mode-abbrev-table)
    1549. 

  1549. 

  1550. (defun nmcobol-setup-abbrevs ()
    1551. 

  1551.   "Installs the `nmcobol-mode-abbrev-table' as `local-abbrev-table'"
    1552. 

  1552.   (define-abbrev-table
    1553. 

  1553.     'nmcobol-mode-abbrev-table
    1554. 

  1554.     nmcobol-mode-abbrev-table-list)
    1555. 

  1555.   (setq local-abbrev-table nmcobol-mode-abbrev-table)
    1556. 

  1556.   (setq skeleton-further-elements '((abbrev-mode nil)))
    1557. 

  1557.   (abbrev-mode nmcobol-abbrev-mode)    ;Setting is documented as buffer local
    1558. 

  1558. )
    1559. 

  1559. 

  1560. ;;; Eldoc support
    1561. 

  1561. 

  1562. (defcustom nmcobol-eldoc-def-files ()
    1563. 

  1563.   "List of files containing function help strings used by `eldoc-mode'.
    1564. 

  1564. These are the strings eldoc-mode displays as help for functions near point.
    1565. 

  1565. The format of the file must be exactly as follows or who knows what happens.
    1566. 

  1566. 

  1567.    (set (intern \"<fcn-name1>\" nmcobol-eldoc-obarray) <helper string1>)
    1568. 

  1568.    (set (intern \"<fcn-name2>\" nmcobol-eldoc-obarray) <helper string2>)
    1569. 

  1569. ...
    1570. 

  1570. 

  1571. Where <fcn-name> is the name of the function to which <helper string> applies.
    1572. 

  1572.       <helper-string> is the string to display when point is near <fcn-name>.
    1573. 

  1573. 

  1574.       Alternatively <helper-string> can be a list where the first element is
    1575. 

  1575.       the help string mentioned above and the second element is a string
    1576. 

  1576.       containing the filename of the file where <fcn-name> is defined.
    1577. 

  1577.       For example '(\"Help string here\" \"source\\of_help.here\")
    1578. 

  1578.       When present `nmcobol-eldoc-where-def' and `nmcobol-eldoc-visit-file'
    1579. 

  1579.       use it."
    1580. 

  1580.   :type '(repeat string)
    1581. 

  1581.   :group 'nmcobol)
    1582. 

    1583. 

  1583. (defvar nmcobol-eldoc-obarray ()
    1584. 

  1584.   "Global Keywords & variables and their associated help strings stored here.")
    1585. 

  1585. 

  1586. (defvar nmcobol-eldoc-local-obarray ()
    1587. 

  1587.   "Local variables and their associated help strings stored here.")
    1588. 

  1588. (make-variable-buffer-local 'nmcobol-eldoc-local-obarray)
    1589. 

    1590. 

  1590. (defcustom nmcobol-eldoc-highlight-face 'match
    1591. 

  1591.   "Face used to highlight a variable name when displayed by eldoc."
    1592. 

  1592.   :type 'face
    1593. 

  1593.   :group 'nmcobol)
    1594. 

    1595. 

  1595. (defun nmcobol-eldoc-context (&optional type)
    1596. 

  1596.   "If TYPE is nil or 'doc return the doc string for the symbol near point
    1597. 

  1597. or nil if none.  If TYPE is 'file return the file where the symbol was
    1598. 

  1598. defined or nil. If TYPE is 'word return the buffer keyword being looked up."
    1599. 

  1599.   (let* ((word (thing-at-point 'symbol))
    1600. 

  1600.          name symbol value)
    1601. 

  1601.     (when word
    1602. 

  1602.       (setq word (upcase word)
    1603. 

  1603.             name (concat (save-excursion
    1604. 

  1604.                            (beginning-of-line)
    1605. 

  1605.                            (char-to-string (char-after))) word)
    1606. 

  1606.             symbol (or (intern-soft name nmcobol-eldoc-local-obarray)
    1607. 

  1607.                        (intern-soft name nmcobol-eldoc-obarray)))
    1608. 

  1608.       (when symbol
    1609. 

  1609.         (setq value (symbol-value symbol))
    1610. 

  1610.         (cond
    1611. 

  1611.          ((eq type 'word) (setq value (downcase word)))
    1612. 

  1612.          ((eq type 'file) (setq value (if (listp value)(cadr value))))
    1613. 

  1613.          (type (setq value nil))
    1614. 

  1614.          (t (unless (stringp value) (setq value (car value))))))
    1615. 

  1615.       value)))
    1616. 

  1616. 

  1617. (defun nmcobol-eldoc-function ()
    1618. 

  1618.   "Returns a documentation string appropriate for the current context or nil."
    1619. 

  1619.   (let* ((value (nmcobol-eldoc-context))
    1620. 

  1620.          word)
    1621. 

  1621.     (when (and value (setq word (nmcobol-eldoc-context 'word)))
    1622. 

  1622.       ;; highlight symbol in the help string
    1623. 

  1623.       (if (string-match (concat "\\(?:^\\|\\.\\)" (regexp-opt (list word) t)
    1624. 

  1624.                                 "\\( \\|\\.\\)") value)
    1625. 

  1625.           (put-text-property (match-beginning 1) (match-end 1)
    1626. 

  1626.                              'face nmcobol-eldoc-highlight-face
    1627. 

  1627.                              value)))
    1628. 

  1628.       value))
    1629. 

  1629. 

  1630. (defun nmcobol-eldoc-where-def ()
    1631. 

  1631.   "Displays the filename from which current eldoc string was extracted."
    1632. 

  1632.   (interactive)
    1633. 

  1633.   (let* ((fname (nmcobol-eldoc-context 'file)))
    1634. 

  1634.     (if fname
    1635. 

  1635.         (message "Symbol defined in %s" fname)
    1636. 

  1636.       (if (nmcobol-eldoc-context 'word)
    1637. 

  1637.           (message "Filename not available")
    1638. 

  1638.         (message "No eldoc info for context")))))
    1639. 

  1639. 

  1640. (defun nmcobol-eldoc-visit-file ()
    1641. 

  1641.   "Visits the file from which current eldoc string was extracted."
    1642. 

  1642.   (interactive)
    1643. 

  1643.   (let* ((fname (nmcobol-eldoc-context 'file))
    1644. 

  1644.          (word  (nmcobol-eldoc-context 'word)))
    1645. 

  1645.     (if fname
    1646. 

  1646.         (progn (find-file fname)
    1647. 

  1647.                (message "Searching for %s" word)
    1648. 

  1648.                (goto-char (point-min))
    1649. 

  1649.                (re-search-forward (concat " " word "[ ;.(\t\n)]")))
    1650. 

  1650.       (if word
    1651. 

  1651.           (message "Filename not available")
    1652. 

  1652.         (message "No eldoc info for context")))))
    1653. 

  1653. 

  1654. (defun nmcobol-setup-eldoc ()
    1655. 

  1655.   "Loads the function documentation for use with eldoc."
    1656. 

  1656.   (set (make-local-variable 'eldoc-documentation-function)
    1657. 

  1657.        'nmcobol-eldoc-function)
    1658. 

  1658.   (unless (vectorp nmcobol-eldoc-obarray)
    1659. 

  1659.     (setq nmcobol-eldoc-obarray (make-vector 41 0))
    1660. 

  1660.     (condition-case var (mapc 'load nmcobol-eldoc-def-files)
    1661. 

  1661.       (error (message "*** ERROR *** %s" var))))
    1662. 

  1662.   (nmcobol-eldoc-scan-buffer))
    1663. 

  1663. 

  1664. (defvar nmcobol-eldoc-definition-regexp
    1665. 

  1665.   (concat "^\\(?:"
    1666. 

  1666.           "\\?SECTION\\|"
    1667. 

  1667.           " +\\([0-9][0-9]\\)\\|"
    1668. 

  1668.           " \\{0,3\\}\\(def\\(?:inition\\)?\\|rec\\(?:ord\\)?\\)\\) +\\(\\w+\\)"
    1669. 

  1669.           "\\(?: +\\(\\w.+$\\)\\| *\\.\\| *\\,\\)")
    1670. 

  1670.   "Expression describing variable and 88 level declarations for eldoc.
    1671. 

  1671. Used by `nmcobol-eldoc-make-list' in creating `eldoc' entries.
    1672. 

  1672. Match strings are:
    1673. 

  1673. 1 = numeric-level (if any)
    1674. 

  1674. 2 = non numeric level (if any)
    1675. 

  1675. 3 = data name (unless 1 and 2 both nil then this is nil too)
    1676. 

  1676. 4 = picture, value, occurs etc doc clause (if any, else nil)")
    1677. 

    1678. 

  1678. (defun nmcobol-eldoc-next-level ()
    1679. 

  1679.   "Returns level number with match-data set for next data or nil."
    1680. 

  1680.   (and (re-search-forward nmcobol-eldoc-definition-regexp () t)
    1681. 

  1681.        (match-string-no-properties 3)
    1682. 

  1682.        (if (match-string-no-properties 1)
    1683. 

  1683.            (let ((num (string-to-number (match-string-no-properties 1))))
    1684. 

  1684.              (if (or (= 66 num)(= 77 num)) 1 num))
    1685. 

  1685.          1)))
    1686. 

  1686. 

  1687. (defun nmcobol-eldoc-write-entry (buf file-name context last-level)
    1688. 

  1688.   "Creates the eldoc entry in BUF using current match-data.
    1689. 

  1689. Returns `nmcobol-eldoc-next-level' data when it returns a level <= LEVEL."
    1690. 

  1690.   (let* ((name (upcase (match-string-no-properties 3)))
    1691. 

  1691.          (doc (match-string-no-properties 4))
    1692. 

  1692.          (next-context (concat context name "."))
    1693. 

  1693.          (result (concat context name " " doc))
    1694. 

  1694.          (level (nmcobol-eldoc-next-level)))
    1695. 

  1695.     (when (and (or doc context)
    1696. 

  1696.                (not (string= "FILLER" name)))
    1697. 

  1697.       (if (and level (= 88 level)(/= 88 last-level))
    1698. 

  1698.           (setq result (concat result " +88")))
    1699. 

  1699.       (set (intern (concat " " name) nmcobol-eldoc-local-obarray) result)
    1700. 

  1700.       (setq result (prin1-to-string result))
    1701. 

  1701.       (if buf
    1702. 

  1702.           (with-current-buffer buf
    1703. 

  1703.             (if file-name
    1704. 

  1704.                 (insert (concat "(set (intern \" " name
    1705. 

  1705.                                 "\" nmcobol-eldoc-obarray) '(" result " \""
    1706. 

  1706.                                 file-name "\"))\n"))
    1707. 

  1707.               (insert (concat "(set (intern \" " name
    1708. 

  1708.                               "\" nmcobol-eldoc-obarray) " result ")\n"))))))
    1709. 

  1709.     (while (and level (> level last-level))
    1710. 

  1710.       (setq level (nmcobol-eldoc-write-entry
    1711. 

  1711.                    buf file-name next-context level)))
    1712. 

  1712.     level))
    1713. 

    1714. 

  1714. (defun nmcobol-eldoc-make-list ()
    1715. 

  1715.   "Creates a buffer of eldoc help strings for variables in this buffer.
    1716. 

  1716. Run this while visiting a COBOL/NMCOBOL source or DDL source file to
    1717. 

  1717. create a buffer of eldoc help entries.  Save this buffer somewhere on
    1718. 

  1718. your search path and see `nmcobol-eldoc-def-files'.  See also
    1719. 

  1719. `nmcobol-eldoc-scan-buffer'.
    1720. 

  1720. The optional arguments are for recursive calls only."
    1721. 

  1721.   (interactive)
    1722. 

  1722.   (if (not (or (eq 'nmcobol-mode major-mode) (eq 'ddl-mode major-mode)))
    1723. 

  1723.       (error "Buffer is not ddl or nmcobol-mode!  Can't extract help text."))
    1724. 

  1724.   (let ((new-buf (get-buffer-create "nmcobol-eldoc-list.el"))
    1725. 

  1725.         (this-buf (buffer-file-name))
    1726. 

  1726.         level)
    1727. 

  1727.     (setq nmcobol-eldoc-local-obarray (make-vector 41 0))
    1728. 

  1728.     (with-current-buffer new-buf
    1729. 

  1729.       (goto-char (point-max))
    1730. 

  1730.       (if this-buf (insert (concat ";; from " this-buf "\n"))))
    1731. 

  1731.     (save-excursion
    1732. 

  1732.       (message "Processing eldoc entries.")
    1733. 

  1733.       (goto-char (point-min))
    1734. 

  1734.       (setq level (nmcobol-eldoc-next-level))
    1735. 

  1735.       (while level
    1736. 

  1736.         (setq level (nmcobol-eldoc-write-entry new-buf this-buf () level))))
    1737. 

  1737.     (switch-to-buffer new-buf)
    1738. 

  1738.     (emacs-lisp-mode)))
    1739. 

    1740. 

  1740. (defun nmcobol-eldoc-scan-buffer ()
    1741. 

  1741.   "Rescans the current buffer, updating in-memory eldoc entries."
    1742. 

  1742.   (interactive)
    1743. 

  1743.   (setq nmcobol-eldoc-local-obarray (make-vector 41 0))
    1744. 

  1744.   (message "Updating in-memory eldoc entries.")
    1745. 

  1745.   (let (level)
    1746. 

  1746.     (save-excursion
    1747. 

  1747.       (goto-char (point-min))
    1748. 

  1748.       (setq level (nmcobol-eldoc-next-level))
    1749. 

  1749.       (while level
    1750. 

  1750.         (setq level (nmcobol-eldoc-write-entry () () () level)))))
    1751. 

  1751.   (message "nmcobol-eldoc-scan-buffer complete"))
    1752. 

    1753. 

    1754. 

  1754. ;;; (thing-at-point 'filename) support
    1755. 

    1756. 

  1756. (defun nmcobol-setup-thing-at-point ()
    1757. 

  1757.   "Makes a buffer local version of `thing-at-point-file-name-chars'"
    1758. 

  1758.   (defvar thing-at-point-file-name-chars)
    1759. 

  1759.   (set (make-local-variable
    1760. 

  1760.         'thing-at-point-file-name-chars) "[:alnum:]=\\$.?*#_^-"))
    1761. 

    1762. 

  1762. ;;; anchored-transpose support
    1763. 

  1763. (eval-when-compile (require 'anchored-transpose))
    1764. 

  1764. (defun nmcobol-setup-anchored-transpose ()
    1765. 

  1765.   "By default a trailing period is not included in text begin swapped."
    1766. 

  1766.  (set (make-local-variable 'anchored-transpose-fuzzy-r1beg) "[\t ]+")
    1767. 

  1767.  (set (make-local-variable 'anchored-transpose-fuzzy-r1end) "\\s *[.!?]?\\s *")
    1768. 

  1768.  (set (make-local-variable 'anchored-transpose-fuzzy-r2beg) "[\t ]+")
    1769. 

  1769.  (set (make-local-variable 'anchored-transpose-fuzzy-r2end) "\\s *[.!?]?\\s *"))
    1770. 

    1771. 

  1771. ;;; Movement by ...
    1772. 

  1772. 

  1773. (defcustom nmcobol-sentence-includes-comments t
    1774. 

  1774.   "Movement by sentences includes immediately adjacent comments if non-nil"
    1775. 

  1775.   :type 'boolean
    1776. 

  1776.   :group 'nmcobol)
    1777. 

    1778. 

  1778. (defvar nmcobol-sentence-end-token
    1779. 

  1779.   "\\.\\s-"
    1780. 

  1780.   "Cobol's sentence end token is a period and one whitespace character.")
    1781. 

  1781. (defvar nmcobol-not-a-paragraph-regexp
    1782. 

  1782.   "\\(e\\(?:nd-if\\|xit\\)\\) *\\."
    1783. 

  1783.   "Match stmts confused as paragraph names by `nmcobol-num-or-paragraph-regexp'")
    1784. 

  1784. (defvar nmcobol-num-or-paragraph-regexp
    1785. 

  1785.   (concat "\\(?:\\([0-8][0-9]\\)[ \n]"
    1786. 

  1786.           "\\|\\(\\(?:f\\|s\\)d\\)[ \n]"
    1787. 

  1787.           "\\|\\(\\w+\\)"
    1788. 

  1788.           "\\(?: +\\(section\\|division\\)[ .\n]"
    1789. 

  1789.           "\\| *\\.\\)\\)")
    1790. 

  1790.   "Expression to find numeric or paragraph boundaries.  Match strings are:
    1791. 

  1791.   1 - numeric data level,
    1792. 

  1792.   2 - string FD or SD,
    1793. 

  1793.   3 - string paragraph name,
    1794. 

  1794.   4 - string SECTION or DIVISION.")
    1795. 

  1795. (defun nmcobol-beginning-of-sentence ()
    1796. 

  1796.   "Moves to the canonical start of a Cobol sentence.
    1797. 

  1797. Either beginning-of-line containing the first keyword or the
    1798. 

  1798. beginning of a comment section prior to the keyword depending on
    1799. 

  1799. the flag `nmcobol-sentence-includes-comments'
    1800. 

  1800. Returns the type of sentence we're at the start of.
    1801. 

  1801. If a numbered data definition the numeric level is returned.
    1802. 

  1802. If an FD or SD sentence the string FD or SD is returned.
    1803. 

  1803. If a section or division statement the corresponding string is returned.
    1804. 

  1804. If the statement is a paragraph name the name is returned.
    1805. 

  1805. Otherwise nil is returned."
    1806. 

  1806.   (save-match-data
    1807. 

  1807.     ;; Make room for backward sentence to see the period
    1808. 

  1808.     (if (looking-back "\\.") (forward-char))
    1809. 

  1809.     (nmcobol-backward-sentence 1 t)
    1810. 

  1810.     ;; Make room for next search to see a potential leading space char.
    1811. 

  1811.     (if (and (looking-at "\\S-")(not (bobp)))(backward-char))
    1812. 

  1812.     ;; I should now be at the end of the prior sentence.
    1813. 

  1813.     (let ((looking t))
    1814. 

  1814.       ;; look for a word character
    1815. 

  1815.       (while
    1816. 

  1816.           (and looking
    1817. 

  1817.                (re-search-forward " \\(\\w\\|\\s(\\|\\s)\\)" () 'move-anyway))
    1818. 

  1818.         (backward-char)
    1819. 

  1819.         (if (save-excursion (beginning-of-line)
    1820. 

  1820.                             (not (looking-at nmcobol-non-cobol-regexp)))
    1821. 

  1821.             (setq looking nil)
    1822. 

  1822.           (beginning-of-line)
    1823. 

  1823.           (while (looking-at nmcobol-non-cobol-regexp)
    1824. 

  1824.             (forward-line 1))))
    1825. 

  1825.       (if (looking-back "^ +" (line-beginning-position))
    1826. 

  1826.           (let ((type (if (looking-at nmcobol-num-or-paragraph-regexp)
    1827. 

  1827.                           (or (match-string-no-properties 2)
    1828. 

  1828.                               (match-string-no-properties 4)
    1829. 

  1829.                               (match-string-no-properties 3)
    1830. 

  1830.                               (string-to-number
    1831. 

  1831.                                (match-string-no-properties 1))))))
    1832. 

  1832.             (if (looking-at nmcobol-not-a-paragraph-regexp)
    1833. 

  1833.                 (setq type nil))
    1834. 

  1834.             (beginning-of-line)
    1835. 

  1835.             (when (and nmcobol-sentence-includes-comments (not (bobp)))
    1836. 

  1836.               (while (and (= 0 (forward-line -1))
    1837. 

  1837.                           (looking-at nmcobol-non-cobol-regexp)))
    1838. 

  1838.               (forward-line))
    1839. 

  1839.             type)))))
    1840. 

    1841. 

  1841. (defun nmcobol-forward-sentence (count)
    1842. 

  1842.   "Move forward past COUNT Cobol sentence end tokens.
    1843. 

  1843. COUNT must be a positive number.  Called by advice on forward-sentence.
    1844. 

  1844. See also `nmcobol-sentence-end-token'.  Returns 0 if successful, N if
    1845. 

  1845. movement stopped prior to COUNT sentence end tokens were found."
    1846. 

  1846.   (save-match-data
    1847. 

  1847.     (while (and (< 0 count)
    1848. 

  1848.                 (re-search-forward nmcobol-sentence-end-token () 'move-anyway))
    1849. 

  1849.       (backward-char)
    1850. 

  1850.       (if (save-excursion (beginning-of-line)
    1851. 

  1851.                           (looking-at nmcobol-non-cobol-regexp))
    1852. 

  1852.           (while (progn
    1853. 

  1853.                    (forward-line 1)
    1854. 

  1854.                    (looking-at nmcobol-non-cobol-regexp)))
    1855. 

  1855.         (setq count (1- count)))
    1856. 

  1856.       (forward-char)))
    1857. 

  1857.   count)
    1858. 

  1858. 

  1859. (defun nmcobol-backward-sentence (count &optional recursive)
    1860. 

  1860.   "Move backward over COUNT Cobol periods then forward outside sentence.
    1861. 

  1861. COUNT must be a positive number.  See `nmcobol-sentence-end-token' for
    1862. 

  1862. the definition of where outside a sentence is.  RECURSIVE is used
    1863. 

  1863. internally to see if point is within or between sentences. Called by
    1864. 

  1864. advice on `forward-sentence'."
    1865. 

  1865.   (save-match-data
    1866. 

  1866.     (unless recursive
    1867. 

  1867.       (let ((prev (point)))
    1868. 

  1868.         (nmcobol-beginning-of-sentence)
    1869. 

  1869.         (if (< (point) prev)
    1870. 

  1870.             (if (= 0 count)(set-match-data (list (point)(point))))
    1871. 

  1871.           (setq count (1+ count)))))
    1872. 

  1872.     (while (and (< 0 count)
    1873. 

  1873.                 (re-search-backward nmcobol-sentence-end-token () 'move-anyway))
    1874. 

  1874.       (if (save-excursion (beginning-of-line)
    1875. 

  1875.                           (not (looking-at nmcobol-non-cobol-regexp)))
    1876. 

  1876.           (setq count (1- count))
    1877. 

  1877.         (beginning-of-line)
    1878. 

  1878.         (while (looking-at nmcobol-non-cobol-regexp)
    1879. 

  1879.           (forward-line -1))
    1880. 

  1880.         (forward-line)))
    1881. 

  1881.     (if (= 0 count)
    1882. 

  1882.         (goto-char (match-end 0))
    1883. 

  1883.       (setq count (1- count))))
    1884. 

  1884.   count)
    1885. 

  1885. 

  1886. (defadvice forward-sentence
    1887. 

  1887.   (around nmcobol-ad-forward-sentence activate)
    1888. 

  1888.   "In nmcobol-mode, moves by Cobol sentences."
    1889. 

  1889.   (if (eq major-mode 'nmcobol-mode)
    1890. 

  1890.       (if (and (not (eq t nmcobol-sentence-includes-comments))
    1891. 

  1891.                (save-excursion (beginning-of-line)
    1892. 

  1892.                                (save-match-data
    1893. 

  1893.                                  (looking-at nmcobol-non-cobol-regexp))))
    1894. 

  1894.           ad-do-it
    1895. 

  1895.         (if (or (unless (ad-get-arg 0) (ad-set-arg 0 1) nil)
    1896. 

  1896.                 (= 0 (setq ad-return-value (ad-get-arg 0)))
    1897. 

  1897.                 (= 0 (setq ad-return-value
    1898. 

  1898.                            (cond
    1899. 

  1899.                             ((< 0 (ad-get-arg 0))
    1900. 

  1900.                              (nmcobol-forward-sentence (ad-get-arg 0)))
    1901. 

  1901.                             ((> 0 (ad-get-arg 0))
    1902. 

  1902.                              (nmcobol-backward-sentence (- (ad-get-arg 0))))))))
    1903. 

  1903.             (if (= 0 ad-return-value)
    1904. 

  1904.                 (nmcobol-beginning-of-sentence))))
    1905. 

  1905.     ad-do-it))
    1906. 

  1906. 

  1907. (defun nmcobol-forward-paragraph (count)
    1908. 

  1908.   "Moves forward by data levels or paragraphs; COUNT times.
    1909. 

  1909. Returns 0 if successful or COUNT minus the number of paragraphs moved."
    1910. 

  1910.   (let ((context (nmcobol-beginning-of-sentence)))
    1911. 

  1911.     (while (and (< 0 count)
    1912. 

  1912.                 (not (eobp))
    1913. 

  1913.                 (setq count (1- count)
    1914. 

  1914.                       context (nmcobol-next-paragraph context)))))
    1915. 

  1915.   count)
    1916. 

  1916. 

  1917. (defun nmcobol-backward-paragraph (count)
    1918. 

  1918.   "Moves backward by data levels or paragraphs; COUNT times.
    1919. 

  1919. Returns 0 if successful or COUNT minus the number of paragraphs moved."
    1920. 

  1920.   (let ((prev (point))
    1921. 

  1921.         (context (nmcobol-beginning-of-sentence)))
    1922. 

  1922.     (if (and (< (point) prev)
    1923. 

  1923.              context)
    1924. 

  1924.         (if (< 0 count) (setq count (1- count))))
    1925. 

  1925.     (while (and (< 0 count)
    1926. 

  1926.                 (not (bobp))
    1927. 

  1927.                 (setq count (1- count)
    1928. 

  1928.                       context (nmcobol-prior-paragraph context)))))
    1929. 

  1929.   count)
    1930. 

  1930. 

  1931. (defun nmcobol-next-paragraph (context)
    1932. 

  1932.   "Moves forward to the next data level or paragraph marker based on CONTEXT.
    1933. 

  1933. Returns the new context where nil means `eobp' reached before next paragraph.
    1934. 

  1934. See `nmcobol-beginning-of-sentence' for possible context values."
    1935. 

  1935.   (if (numberp context)
    1936. 

  1936.       ;; Numbered paragraphs are handled based on data level
    1937. 

  1937.       (let ((next-context (and (= 0 (nmcobol-forward-sentence 1))
    1938. 

  1938.                                (nmcobol-beginning-of-sentence))))
    1939. 

  1939.         (if (numberp next-context)
    1940. 

  1940.             (cond
    1941. 

  1941.              ;; anything besides another 77 terminates a 77
    1942. 

  1942.              ((= context 77)
    1943. 

  1943.               (while (and (numberp next-context)
    1944. 

  1944.                           (= next-context 77))
    1945. 

  1945.                 (setq next-context
    1946. 

  1946.                       (and (= 0 (nmcobol-forward-sentence 1))
    1947. 

  1947.                            (nmcobol-beginning-of-sentence)))))
    1948. 

  1948.              ;; when next number is same as current look for a lower numbered
    1949. 

  1949.              ;; level, a 77, or unnumbered, to terminate 'paragraph'.
    1950. 

  1950.              ((= next-context context)
    1951. 

  1951.               (while (and
    1952. 

  1952.                       (numberp (setq next-context
    1953. 

  1953.                                      (and (= 0 (nmcobol-forward-sentence 1))
    1954. 

  1954.                                           (nmcobol-beginning-of-sentence))))
    1955. 

  1955.                       (>= next-context context)
    1956. 

  1956.                       (/= next-context 77)
    1957. 

  1957.                       (/= next-context 66))))
    1958. 

  1958.              ;; When next number is higher than current, look for same or lower
    1959. 

  1959.              ;; numbered level, a 77, or unnumbered, to terminate 'paragraph'.
    1960. 

  1960.              ((and (> next-context context)
    1961. 

  1961.                    (/= next-context 77)
    1962. 

  1962.                    (/= next-context 66))
    1963. 

  1963.               (while (and
    1964. 

  1964.                       (numberp (setq next-context
    1965. 

  1965.                                      (and (= 0 (nmcobol-forward-sentence 1))
    1966. 

  1966.                                           (nmcobol-beginning-of-sentence))))
    1967. 

  1967.                       (> next-context context)
    1968. 

  1968.                       (/= next-context 77)
    1969. 

  1969.                       (/= next-context 66))))
    1970. 

  1970.              ;; If next-context = 77 or is < context then we're already done.
    1971. 

  1971.             )
    1972. 

  1972.           ;; if next-context isn't numbered then we're already done
    1973. 

  1973.         )
    1974. 

  1974.         next-context)
    1975. 

  1975.     ;; Normal paragraph movement
    1976. 

  1976.     (while (and (= 0 (nmcobol-forward-sentence 1))
    1977. 

  1977.                 (not (setq context (nmcobol-beginning-of-sentence)))))
    1978. 

  1978.     context))
    1979. 

  1979. 

  1980. (defun nmcobol-prior-paragraph (context)
    1981. 

  1981.   "Moves backward to the next data level or paragraph marker based on CONTEXT.
    1982. 

  1982. Returns the new context where nil means `bobp' reached before a paragraph start.
    1983. 

  1983. See `nmcobol-beginning-of-sentence' for possible context values."
    1984. 

  1984.   (if (numberp context)
    1985. 

  1985.       ;; Numbered paragraphs are handled based on data level
    1986. 

  1986.       (let ((next-context (and (= 0 (nmcobol-backward-sentence 1))
    1987. 

  1987.                                (nmcobol-beginning-of-sentence))))
    1988. 

  1988.         (if (numberp next-context)
    1989. 

  1989.             (cond
    1990. 

  1990.              ;; anything besides another 77 terminates a 77
    1991. 

  1991.              ((= context 77)
    1992. 

  1992.               (while (and (numberp next-context)
    1993. 

  1993.                           (= next-context 77))
    1994. 

  1994.                 (setq next-context
    1995. 

  1995.                       (and (= 0 (nmcobol-backward-sentence 1))
    1996. 

  1996.                            (nmcobol-beginning-of-sentence)))))
    1997. 

  1997.              ;; when next number is same as current look for a lower numbered
    1998. 

  1998.              ;; level, a 77, or unnumbered, to terminate 'paragraph'.
    1999. 

  1999.              ((= next-context context)
    2000. 

  2000.               (while (and
    2001. 

  2001.                       (numberp (setq next-context
    2002. 

  2002.                                      (and (= 0 (nmcobol-backward-sentence 1))
    2003. 

  2003.                                           (nmcobol-beginning-of-sentence))))
    2004. 

  2004.                       (>= next-context context)
    2005. 

  2005.                       (/= next-context 77)
    2006. 

  2006.                       (/= next-context 66))))
    2007. 

  2007.              ;; When next number is higher than current, look for same or lower
    2008. 

  2008.              ;; numbered level, a 77, or unnumbered, to terminate 'paragraph'.
    2009. 

  2009.              ((and (> next-context context)
    2010. 

  2010.                    (/= next-context 77)
    2011. 

  2011.                    (/= next-context 66))
    2012. 

  2012.               (while (and
    2013. 

  2013.                       (numberp (setq next-context
    2014. 

  2014.                                      (and (= 0 (nmcobol-backward-sentence 1))
    2015. 

  2015.                                           (nmcobol-beginning-of-sentence))))
    2016. 

  2016.                       (> next-context context)
    2017. 

  2017.                       (/= next-context 77)
    2018. 

  2018.                       (/= next-context 66))))
    2019. 

  2019.              ;; If next-context = 77 or is < context then we're already done.
    2020. 

  2020.             )
    2021. 

  2021.           ;; if next-context isn't numbered then we're already done
    2022. 

  2022.         )
    2023. 

  2023.         next-context)
    2024. 

  2024.     ;; Normal paragraph movement
    2025. 

  2025.     (while (and (= 0 (nmcobol-backward-sentence 1))
    2026. 

  2026.                 (not (stringp (setq context (nmcobol-beginning-of-sentence)))))
    2027. 

  2027.       (setq context nil))
    2028. 

  2028.     context))
    2029. 

  2029. 

  2030. (defadvice forward-paragraph
    2031. 

  2031.   (around nmcobol-ad-forward-paragraph activate)
    2032. 

  2032.   "In nmcobol-mode, moves by numbered data levels or Cobol paragraphs.
    2033. 

  2033. Uses `nmcobol-beginning-of-sentence' in determining how to move."
    2034. 

  2034.   (if (eq major-mode 'nmcobol-mode)
    2035. 

  2035.       (if (and (not (eq t nmcobol-sentence-includes-comments))
    2036. 

  2036.                (save-excursion (beginning-of-line)
    2037. 

  2037.                                (looking-at nmcobol-non-cobol-regexp)))
    2038. 

  2038.           ad-do-it
    2039. 

  2039.         (setq ad-return-value
    2040. 

  2040.               (if (or (unless (ad-get-arg 0) (ad-set-arg 0 1) nil)
    2041. 

  2041.                       (< 0 (ad-get-arg 0)))
    2042. 

  2042.                   (nmcobol-forward-paragraph (ad-get-arg 0))
    2043. 

  2043.               (nmcobol-backward-paragraph (- (ad-get-arg 0))))))
    2044. 

  2044.     ad-do-it))
    2045. 

    2046. 

  2046. ;; User programming utility functions
    2047. 

    2048. 

  2048. (defcustom nmcobol-pic-string-regexp
    2049. 

  2049.   (concat "pic\\(?:ture\\)?\\s-+\\([-abnpsvxz0-9.,()/+crd*$]*"
    2050. 

  2050.           "[-abnpvxz0-9()/+crd*$]+\\)\\(\\.?[ \t]\\|\\.?$\\)")
    2051. 

  2051.   "Used by `nmcobol-addup-pics' to find picture strings."
    2052. 

  2052.   :type  'regexp
    2053. 

  2053.   :group 'nmcobol)
    2054. 

    2055. 

  2055. (defun nmcobol-pic-string-length(string)
    2056. 

  2056.   "Used internally.  Returns the length a picture string represents."
    2057. 

  2057.   (let ((len (length string))
    2058. 

  2058.         (off 0))
    2059. 

  2059.         (while (string-match "[abnpxz90*$](\\([0-9]+\\))" string off)
    2060. 

  2060.           (setq len (+ (string-to-number (match-string-no-properties 1 string))
    2061. 

  2061.                        (- len (length (match-string-no-properties 0 string))))
    2062. 

  2062.                 off (match-end 0)))
    2063. 

  2063.         len))
    2064. 

  2064. 

  2065. (defun nmcobol-addup-pics (begin end)
    2066. 

  2066.   "Adds the length represented by all picture strings in the region.
    2067. 

  2067. Eventually I'd like for it to account for REDEFINES.  It DOESN'T now."
    2068. 

  2068.   (interactive "r")
    2069. 

  2069.   (if mark-active
    2070. 

  2070.       (save-excursion
    2071. 

  2071.         (goto-char begin)
    2072. 

  2072.         (let ((sum 0))
    2073. 

  2073.           (while (re-search-forward nmcobol-pic-string-regexp end t)
    2074. 

  2074.             (setq sum (+ sum (nmcobol-pic-string-length
    2075. 

  2075.                               (match-string-no-properties 1)))))
    2076. 

  2076.           (message "PIC[TURE] clauses add up to %d" sum)))
    2077. 

  2077.     (message "Select a region to operate upon.")))
    2078. 

  2078. 

  2079. ;;; Miscellaneous
    2080. 

  2080. 

  2081. (defun nmcobol-setup-paren-mode ()
    2082. 

  2082.   "Adds functions to make show-paren-mode recognize END-<statement> verbs."
    2083. 

  2083.   (require 'paren)
    2084. 

  2084. ;  (if (boundp show-paren-decide-dir-function)
    2085. 

  2085. ;      (set (make-local-variable 'show-paren-decide-dir-function)
    2086. 

  2086. ;           'nmcobol-show-paren-decide-dir))
    2087. 

  2087. ;  (if (boundp show-paren-scan-function)
    2088. 

  2088. ;      (set (make-local-variable 'show-paren-scan-function)
    2089. 

  2089. ;           'nmcobol-show-paren-scan))
    2090. 

  2090.   (show-paren-mode 1))
    2091. 

  2091. 

  2092. (defun nmcobol-customize-options ()
    2093. 

  2093.   "Invokes (customize-group 'nmcobol)"
    2094. 

  2094.   (interactive)
    2095. 

  2095.   (customize-group 'nmcobol))
    2096. 

    2097. 

  2097. (defcustom nmcobol-mode-hook nil
    2098. 

  2098.   "Standard mode hook. Run after entering NMCobol mode."
    2099. 

  2099.   :type 'hook
    2100. 

  2100.   :group 'nmcobol)
    2101. 

    2102. 

  2102. ;;;###autoload
    2103. 

  2103. (defun nmcobol-mode ()
    2104. 

  2104.   "A major mode for editing ?TANDEM format COBOL program source files.
    2105. 

  2105. See `cobol-mode' for ?ANSI format COBOL program source files.
    2106. 

    2107. 

  2107. Customization options are available via
    2108. 

  2108. \\[customize-group] <ret> NMCOBOL <ret>
    2109. 

    2110. 

  2110. This mode provides NMCOBOL specific support for such packages as:
    2111. 

  2111.     `abbrev-mode'          `adaptive-fill-mode'   `anchored-transpose'
    2112. 

  2112.     `auto-fill-mode'       `eldoc-mode'           `filladapt-mode'
    2113. 

  2113.     `font-lock-mode'       `imenu'                `indent-line-function'
    2114. 

  2114.     `show-paren-mode'      `skeleton-insert'      `thing-at-point'
    2115. 

  2115.     `which-function'
    2116. 

    2117. 

  2117.  (thing-at-point 'filename) will return a Guardian filename, define or
    2118. 

  2118.  template if present at point.
    2119. 

  2119. 

  2120. ** Note ** Some things won't work correctly if `font-lock-mode' is off.
    2121. 

  2121. 

  2122. nmcobol-mode implements the following \\[execute-extended-command] ... commands
    2123. 

  2123. 

  2124. `nmcobol-mode'             Activates this mode for the current buffer
    2125. 

  2125. `nmcobol-if-skel'          Inserts an if/then statement skeleton
    2126. 

    2127. 

  2127. \\{nmcobol-mode-map}
    2128. 

  2128. Use \\[describe-bindings] to see ALL key bindings.
    2129. 

  2129. 

  2130. Some settings I like:
    2131. 

  2131. Turn on `skeleton-pair-insert-maybe' for (), [] and \"\"
    2132. 

  2132. Turn on `imenu' and set `imenu-sort-function' to imenu--sort-by-name
    2133. 

  2133. Turn on `recentf-mode'. You might need `recentf-auto-cleanup' = 'never
    2134. 

  2134. Set `column-marker-1' to 79 so you can tell what TEDIT users can't see.
    2135. 

  2135. Load `popup-ruler' for a TEDIT F9 type ruler on steroids.
    2136. 

  2136. I find `transient-mark-mode' totally indespensible.
    2137. 

  2137. CUA mode has some really great rectangle functions."
    2138. 

  2138.   (interactive)
    2139. 

  2139.   (kill-all-local-variables)
    2140. 

  2140.   (set (make-local-variable 'major-mode) 'nmcobol-mode)
    2141. 

  2141.   (set (make-local-variable 'mode-name) "NMCOBOL")
    2142. 

  2142.   (set (make-local-variable 'make-backup-files) nil) ;necessary for now
    2143. 

  2143.   (set-syntax-table nmcobol-mode-syntax-table)
    2144. 

  2144.   (nmcobol-setup-regexp-vars)
    2145. 

  2145.   (use-local-map nmcobol-mode-map)
    2146. 

  2146.   (nmcobol-setup-font-lock)
    2147. 

  2147.   (nmcobol-setup-adaptive-fill)
    2148. 

  2148.   (nmcobol-setup-abbrevs)
    2149. 

  2149.   (nmcobol-setup-imenu)
    2150. 

  2150.   (nmcobol-setup-eldoc)
    2151. 

  2151.   (nmcobol-setup-indent)
    2152. 

  2152.   (nmcobol-setup-skel)
    2153. 

  2153.   (nmcobol-setup-column-markers)
    2154. 

  2154.   (nmcobol-setup-thing-at-point)
    2155. 

  2155.   (nmcobol-setup-anchored-transpose)
    2156. 

  2156.   (nmcobol-setup-paren-mode)
    2157. 

  2157.   (nmcobol-setup-menu)
    2158. 

  2158.   (run-hooks 'nmcobol-mode-hook))
    2159. 

    2160. 

  2160. (provide 'nmcobol-mode)
    2161. 

    2162. 

  2162. ;;; nmcobol-mode.el ends here
    2163. 

    2164.