home *** CD-ROM | disk | FTP | other *** search
/ OS/2 Shareware BBS: 5 Edit / 05-Edit.zip / m2emacs.zip / modula2_el.Z / modula2_el
Lisp/Scheme  |  1998-07-18  |  73KB  |  2,273 lines
  1. ;;; Modula2.el --- Modula-2 editing support package
  2.  
  3. ;; Authors: Michael Schmidt <michael@pbinfo.UUCP> 
  4. ;;        Tom Perrine     <Perrin@LOGICON.ARPA>
  5. ;;          Egor Ziryanov   <ego@iis.nsk.su>
  6. ;; Keywords: languages
  7.  
  8. ;; The authors distributed this without a copyright notice
  9. ;; back in 1988, so it is in the public domain.  The original included
  10. ;; the following credit:
  11.  
  12. ;; Author Mick Jordan
  13. ;; amended Peter Robinson
  14.  
  15. ;; $RCSfile: modula2.el,v $ $Revision: 1.3 $ $Date: 1997/05/26 14:28:27 $
  16.  
  17. ;;; Commentary:
  18.  
  19. ;; A major mode for editing Modula-2 code.  It provides convenient abbrevs
  20. ;; for Modula-2 keywords, knows about the standard layout rules, and supports
  21. ;; a native compile command.
  22.  
  23. ;; ==========================
  24. ;; How to install it into ~/.emacs
  25.  
  26. ;(or (assoc "\\.ob2$" auto-mode-alist)                                     
  27. ;     (setq auto-mode-alist (cons '("\\.ob2$" . modula-2-mode)
  28. ;                               auto-mode-alist)))                           
  29. ;
  30. ;(or (assoc "\\.mod$" auto-mode-alist)                                     
  31. ;     (setq auto-mode-alist (cons '("\\.mod$" . modula-2-mode)
  32. ;                               auto-mode-alist)))
  33. ;
  34. ;(or (assoc "\\.def$" auto-mode-alist)                                     
  35. ;     (setq auto-mode-alist (cons '("\\.def$" . modula-2-mode)
  36. ;                               auto-mode-alist)))                           
  37.  
  38. ;;===================
  39.  
  40. ;;; Code:
  41.  
  42. ;;; Added by Tom Perrine (TEP)
  43. (defvar m2-mode-syntax-table nil
  44.   "Syntax table in use in Modula-2 buffers.")
  45.  
  46. (defvar m2-compile-command "xc =m"
  47.   "Command to compile Modula-2 programs")
  48.  
  49. (defvar m2-build-command "xc =p"
  50.   "Command to link Modula-2 programs")
  51.  
  52. (defvar m2-project-name nil
  53.   "Name of the executable.")
  54.  
  55. (defvar m2-imenu-generic-expression
  56.   '("^[ \t]*\\(PROCEDURE\\)[ \t\n]+\\([a-zA-Z0-9_.:]+\\)" . (2))
  57.   "Imenu expression for M2-mode.  See `imenu-generic-expression'.")
  58.   
  59. (defvar m2-mode-syntax-table nil
  60.   "Syntax table in use in m2-mode buffers.")
  61.  
  62. (if m2-mode-syntax-table
  63.     ()
  64.   (setq m2-mode-syntax-table (make-syntax-table))
  65.   (modify-syntax-entry ?\\ "."   m2-mode-syntax-table)
  66.   (modify-syntax-entry ?( "()1"  m2-mode-syntax-table)  
  67.   (modify-syntax-entry ?) ")(4"  m2-mode-syntax-table)
  68.   (modify-syntax-entry ?* ". 23" m2-mode-syntax-table)
  69.   (modify-syntax-entry ?{ "<"    m2-mode-syntax-table)
  70.   (modify-syntax-entry ?} ">"    m2-mode-syntax-table)
  71.   (modify-syntax-entry ?+ "."    m2-mode-syntax-table)
  72.   (modify-syntax-entry ?- "."    m2-mode-syntax-table)
  73.   (modify-syntax-entry ?= "."    m2-mode-syntax-table)
  74.   (modify-syntax-entry ?% "."    m2-mode-syntax-table)
  75.   (modify-syntax-entry ?< "."    m2-mode-syntax-table)
  76.   (modify-syntax-entry ?> "."    m2-mode-syntax-table)
  77.   (modify-syntax-entry ?& "."    m2-mode-syntax-table)
  78.   (modify-syntax-entry ?| "."    m2-mode-syntax-table)
  79.   (modify-syntax-entry ?_ "w"    m2-mode-syntax-table)
  80.   (modify-syntax-entry ?. "w"    m2-mode-syntax-table)
  81.   (modify-syntax-entry ?\' "\""  m2-mode-syntax-table))
  82.  
  83. ;;; Added by TEP
  84. (defvar m2-mode-map nil
  85.   "Keymap used in Modula-2 mode.")
  86.  
  87. (if m2-mode-map ()
  88.   (let ((map (make-sparse-keymap)))
  89.     (define-key map "\t" 'm2-tab)
  90.     (define-key map "\C-cb" 'm2-begin)
  91.     (define-key map "\C-cc" 'm2-case)
  92.     (define-key map "\C-cd" 'm2-definition)
  93.     (define-key map "\C-ce" 'm2-else)
  94.     (define-key map "\C-cf" 'm2-for)
  95.     (define-key map "\C-ch" 'm2-header)
  96.     (define-key map "\C-ci" 'm2-if)
  97.     (define-key map "\C-cm" 'm2-module)
  98.     (define-key map "\C-cl" 'm2-loop)
  99.     (define-key map "\C-co" 'm2-or)
  100.     (define-key map "\C-cp" 'm2-procedure)
  101.     (define-key map "\C-c\C-w" 'm2-with)
  102.     (define-key map "\C-cr" 'm2-record)
  103.     (define-key map "\C-ct" 'm2-type)
  104.     (define-key map "\C-cu" 'm2-until)
  105.     (define-key map "\C-cv" 'm2-var)
  106.     (define-key map "\C-cw" 'm2-while)
  107.     (define-key map "\C-cx" 'm2-export)
  108.     (define-key map "\C-cy" 'm2-import)
  109.     (define-key map "\C-c{" 'm2-begin-comment)
  110.     (define-key map "\C-c}" 'm2-end-comment)
  111.     (define-key map "\C-m"  'm2-newline)
  112.     (define-key map "\C-c\C-z" 'suspend-emacs)
  113.     (define-key map "\C-c\C-v" 'm2-visit)
  114.     (define-key map "\C-c\C-t" 'm2-toggle)
  115.     (define-key map "\C-c\C-b" 'm2-build)
  116.     (define-key map "\C-c\C-c" 'm2-compile)
  117.     (define-key map "\177"     'backward-delete-char-untabify)
  118.     (setq m2-mode-map map)))
  119.  
  120. (defvar m2-font-lock-keywords
  121.   (list
  122.    '("^[ \t]*\\(PROCEDURE\\|RETURN\\)\\>[ \t]*\\(\\sw+\\)?"
  123.      (1 font-lock-keyword-face) (3 font-lock-function-name-face nil t))
  124.    ;; Types
  125.    (cons (concat "\\<\\("
  126.          "B\\(OOLEAN\\|ITSET\\)\\|C\\(ARDINAL\\|HAR\\)\\|"
  127.          "FLOAT\\|INTEGER\\|LONG\\(CARD\\|INT\\|REAL\\)\\|"
  128.          "REAL\\|SHORTCARD\\)\\>")
  129.      'font-lock-type-face)
  130.    ;; Standard identifers
  131.    (cons (concat "\\<\\("
  132.          "ABS\\|AND\\|CHR\\|CAP\\|DIV\\|EX\\(CL\\|IT\\)\\|"
  133.          "HALT\\|HIGH\\|IN\\|INC\\|INCL\\|M\\(AX\\|IN\\|OD\\)\\|"
  134.          "NOT\\|O\\(DD\\|R\\|RD\\)\\|SIZE\\|TRUNC\\|VAL\\)\\>")
  135.      'font-lock-function-name-face)
  136.    ;; Standard constants
  137.    '("\\<\\(DISPOSE\\|N\\(IL\\|EW\\)\\|TRUE\\|FALSE\\|PROC\\)\\>" . 
  138.      font-lock-function-name-face)
  139.    '("\\<\\(CONST\\|VAR\\|SEQ\\|TYPE\\)\\>" . font-lock-reference-face)
  140.    '("[|]\\<\\([a-zA-Z_.,0-9]+\\)[ \t]*:" 1 font-lock-reference-face)
  141.    '("\\<\\([a-zA-Z_0-9]+\\)[ \t]*[=]" 1 font-lock-variable-name-face)
  142.    ;; Keywords
  143.    (cons (concat "\\<\\("
  144.        "ARRAY\\|B\\(EGIN\\|Y\\)\\|CASE\\|DO\\|DEFINITION\\|"
  145.        "E\\(LSE\\|LSEIF\\|ND\\|XPORT\\)\\|F\\(OR\\|ROM\\)\\|"
  146.        "IF\\|IMP\\(LEMENTATION\\|ORT\\)\\|LOOP\\|MODULE\\|"
  147.        "OF\\|POINTER\\|RE\\(PEAT\\|CORD\\)\\|SET\\|T\\(HEN\\|O\\)\\|"
  148.        "UNTIL\\|W\\(HILE\\|ITH\\)"
  149.        "\\)\\>") 'font-lock-keyword-face))
  150.   "Additional expressions to highlight in Modula2 mode.")
  151.  
  152. (defvar m2-indent 2
  153.   "*Indentation of Modula2 statements is 2.")
  154.  
  155. ;;;###autoload
  156. (defun modula-2-mode ()
  157.   "This is a mode intended to support program development in Modula-2.
  158. All control constructs of Modula-2 can be reached by typing C-c
  159. followed by the first character of the construct.
  160. \\<m2-mode-map>
  161.   \\[m2-begin] begin         \\[m2-case] case
  162.   \\[m2-definition] definition    \\[m2-else] else
  163.   \\[m2-for] for           \\[m2-header] header
  164.   \\[m2-if] if            \\[m2-module] module
  165.   \\[m2-loop] loop          \\[m2-or] or
  166.   \\[m2-procedure] procedure     Control-c Control-w with
  167.   \\[m2-record] record        \\[m2-stdio] stdio
  168.   \\[m2-type] type          \\[m2-until] until
  169.   \\[m2-var] var           \\[m2-while] while
  170.   \\[m2-export] export        \\[m2-import] import
  171.   \\[m2-begin-comment] begin-comment \\[m2-end-comment] end-comment
  172.   \\[suspend-emacs] suspend Emacs     \\[m2-toggle] toggle
  173.   \\[m2-compile] compile           \\[m2-next-error] next-error
  174.   \\[m2-link] link
  175.  
  176.    `m2-indent' controls the number of spaces for each indentation.
  177.    `m2-compile-command' holds the command to compile a Modula-2 program.
  178.    `m2-build-command' holds the command to link a Modula-2 program."
  179.   (interactive)
  180.   (kill-all-local-variables)
  181.   (use-local-map m2-mode-map)
  182.   (setq major-mode 'modula-2-mode)
  183.   (setq mode-name "Modula-2")
  184.   (make-local-variable 'comment-column)
  185.   (setq comment-column 41)
  186.   (make-local-variable 'end-comment-column)
  187.   (setq end-comment-column 75)
  188.   (set-syntax-table m2-mode-syntax-table)
  189.   (make-local-variable 'paragraph-start)
  190.   (setq paragraph-start (concat "$\\|" page-delimiter))
  191.   (make-local-variable 'paragraph-separate)
  192.   (setq paragraph-separate paragraph-start)
  193.   (make-local-variable 'case-fold-search)
  194.   (setq case-fold-search nil)
  195.   (make-local-variable 'paragraph-ignore-fill-prefix)
  196.   (setq paragraph-ignore-fill-prefix t)
  197.   (make-local-variable 'indent-line-function)
  198.   (setq indent-line-function 'm2-indent-line)
  199.   (make-local-variable 'require-final-newline)
  200.   (setq require-final-newline t)
  201.   (make-local-variable 'comment-start)
  202.   (setq comment-start "(*")
  203.   (make-local-variable 'comment-end)
  204.   (setq comment-end "*)")
  205.   (make-local-variable 'comment-start-skip)
  206.   (setq comment-start-skip "(\\*+ *")
  207.   (make-local-variable 'comment-indent-function)
  208.   (setq comment-indent-function 'c-comment-indent)
  209.   (make-local-variable 'parse-sexp-ignore-comments)
  210.   (setq parse-sexp-ignore-comments nil)
  211.   (make-local-variable 'font-lock-defaults)
  212.   (setq font-lock-defaults '(m2-font-lock-keywords nil t))
  213.   (run-hooks 'm2-mode-hook))
  214.  
  215. (defun m2-newline ()
  216.   "Insert a newline and indent following line like previous line."
  217.   (interactive)
  218.   (let ((hpos (current-indentation)))
  219.     (newline)
  220.     (indent-to hpos)))
  221.  
  222. (defun m2-tab ()
  223.   "Indent to next tab stop."
  224.   (interactive)
  225.   (indent-to (* (1+ (/ (current-indentation) m2-indent)) m2-indent)))
  226.  
  227. (defun m2-begin ()
  228.   "Insert a BEGIN keyword and indent for the next line."
  229.   (interactive)
  230.   (insert "BEGIN")
  231.   (m2-newline)
  232.   (m2-tab))
  233.  
  234. (defun m2-case ()
  235.   "Build skeleton CASE statment, prompting for the <expression>."
  236.   (interactive)
  237.   (let ((name (read-string "Case-Expression: ")))
  238.     (insert "CASE " name " OF")
  239.     (m2-newline)
  240.     (m2-newline)
  241.     (insert "END (* case " name " *);"))
  242.   (end-of-line 0)
  243.   (m2-tab))
  244.  
  245. (defun m2-definition ()
  246.   "Build skeleton DEFINITION MODULE, prompting for the <module name>."
  247.   (interactive)
  248.   (insert "DEFINITION MODULE ")
  249.   (let ((name (read-string "Name: ")))
  250.     (insert name ";\n\n\n\nEND " name ".\n"))
  251.   (previous-line 3))
  252.  
  253. (defun m2-else ()
  254.   "Insert ELSE keyword and indent for next line."
  255.   (interactive)
  256.   (m2-newline)
  257.   (backward-delete-char-untabify m2-indent ())
  258.   (insert "ELSE")
  259.   (m2-newline)
  260.   (m2-tab))
  261.  
  262. (defun m2-for ()
  263.   "Build skeleton FOR loop statment, prompting for the loop parameters."
  264.   (interactive)
  265.   (insert "FOR ")
  266.   (let ((name (read-string "Loop Initialiser: ")) limit by)
  267.     (insert name " TO ")
  268.     (setq limit (read-string "Limit: "))
  269.     (insert limit)
  270.     (setq by (read-string "Step: "))
  271.     (if (not (string-equal by ""))
  272.     (insert " BY " by))
  273.     (insert " DO")
  274.     (m2-newline)
  275.     (m2-newline)
  276.     (insert "END (* for " name " to " limit " *);"))
  277.   (end-of-line 0)
  278.   (m2-tab))
  279.  
  280. (defun m2-header ()
  281.   "Insert a comment block containing the module title, author, etc."
  282.   (interactive)
  283.   (insert "(*\n    Title: \t")
  284.   (insert (read-string "Title: "))
  285.   (insert "\n    Created:\t")
  286.   (insert (current-time-string))
  287.   (insert "\n    Author: \t")
  288.   (insert (user-full-name))
  289.   (insert (concat "\n\t\t<" (user-login-name) "@" (system-name) ">\n"))
  290.   (insert "*)\n\n"))
  291.  
  292. (defun m2-if ()
  293.   "Insert skeleton IF statment, prompting for <boolean-expression>."
  294.   (interactive)
  295.   (insert "IF ")
  296.   (let ((thecondition (read-string "<boolean-expression>: ")))
  297.     (insert thecondition " THEN")
  298.     (m2-newline)
  299.     (m2-newline)
  300.     (insert "END (* if " thecondition " *);"))
  301.   (end-of-line 0)
  302.   (m2-tab))
  303.  
  304. (defun m2-loop ()
  305.   "Build skeleton LOOP (with END)."
  306.   (interactive)
  307.   (insert "LOOP")
  308.   (m2-newline)
  309.   (m2-newline)
  310.   (insert "END (* loop *);")
  311.   (end-of-line 0)
  312.   (m2-tab))
  313.  
  314. (defun m2-module ()
  315.   "Build skeleton IMPLEMENTATION MODULE, prompting for <module-name>."
  316.   (interactive)
  317.   (insert "IMPLEMENTATION MODULE ")
  318.   (let ((name (read-string "Name: ")))
  319.     (insert name ";\n\n\n\nEND " name ".\n")
  320.     (previous-line 3)
  321.     (m2-header)
  322.     (m2-type)
  323.     (newline)
  324.     (m2-var)
  325.     (newline)
  326.     (m2-begin)
  327.     (m2-begin-comment)
  328.     (insert " Module " name " Initialisation Code "))
  329.   (m2-end-comment)
  330.   (newline)
  331.   (m2-tab))
  332.  
  333. (defun m2-or ()
  334.   (interactive)
  335.   (m2-newline)
  336.   (backward-delete-char-untabify m2-indent)
  337.   (insert "|")
  338.   (m2-newline)
  339.   (m2-tab))
  340.  
  341. (defun m2-procedure ()
  342.   (interactive)
  343.   (insert "PROCEDURE ")
  344.   (let ((name (read-string "Name: " ))
  345.     args)
  346.     (insert name " (")
  347.     (insert (read-string "Arguments: ") ")")
  348.     (setq args (read-string "Result Type: "))
  349.     (if (not (string-equal args ""))
  350.     (insert " : " args))
  351.     (insert ";")
  352.     (m2-newline)
  353.     (insert "BEGIN")
  354.     (m2-newline)
  355.     (m2-newline)
  356.     (insert "END ")
  357.     (insert name)
  358.     (insert ";")
  359.     (end-of-line 0)
  360.     (m2-tab)))
  361.  
  362. (defun m2-with ()
  363.   "Build skeleton WITH (with END), prompting <record-type>."
  364.   (interactive)
  365.   (insert "WITH ")
  366.   (let ((name (read-string "Record-Type: ")))
  367.     (insert name)
  368.     (insert " DO")
  369.     (m2-newline)
  370.     (m2-newline)
  371.     (insert "END (* with " name " *);"))
  372.   (end-of-line 0)
  373.   (m2-tab))
  374.  
  375. (defun m2-record ()
  376.   "Build skeleton RECORD (with END), prompting <record-name>."
  377.   (interactive)
  378.   (insert "RECORD")
  379.   (let ((name (read-string "Record-Name: ")))
  380.     (insert " = ")
  381.     (insert name)
  382.     (m2-newline)
  383.     (m2-newline)
  384.     (insert "END (* record " name " *);"))
  385.   (end-of-line 0)
  386.   (m2-tab))
  387.  
  388. ;(defun m2-stdio ()
  389. ;  (interactive)
  390. ;  (insert "
  391. ;FROM TextIO IMPORT 
  392. ;   WriteCHAR, ReadCHAR, WriteINTEGER, ReadINTEGER,
  393. ;   WriteCARDINAL, ReadCARDINAL, WriteBOOLEAN, ReadBOOLEAN,
  394. ;   WriteREAL, ReadREAL, WriteBITSET, ReadBITSET,
  395. ;   WriteBasedCARDINAL, ReadBasedCARDINAL, WriteChars, ReadChars,
  396. ;   WriteString, ReadString, WhiteSpace, EndOfLine;
  397. ;
  398. ;FROM SysStreams IMPORT sysIn, sysOut, sysErr;
  399. ;
  400. ;"))
  401.  
  402. (defun m2-type ()
  403.   "Insert TYPE statement and indent for next line."
  404.   (interactive)
  405.   (insert "TYPE")
  406.   (m2-newline)
  407.   (m2-tab))
  408.  
  409. (defun m2-until ()
  410.   "Build skeleton REPEAT - UNTIL, prompting <boolean-experession>."
  411.   (interactive)
  412.   (insert "REPEAT")
  413.   (m2-newline)
  414.   (m2-newline)
  415.   (insert "UNTIL ")
  416.   (insert (read-string "<boolean-expression>: ") ";")
  417.   (end-of-line 0)
  418.   (m2-tab))
  419.  
  420. (defun m2-var ()
  421.   "Insert VAR statement and indent for next line."
  422.   (interactive)
  423.   (m2-newline)
  424.   (insert "VAR")
  425.   (m2-newline)
  426.   (m2-tab))
  427.  
  428. (defun m2-while ()
  429.   "Build skeleton WHILE (with END), prompting <boolean-experession>."
  430.   (interactive)
  431.   (insert "WHILE ")
  432.   (let ((name (read-string "<boolean-expression>: ")))
  433.     (insert name " DO" )
  434.     (m2-newline)
  435.     (m2-newline)
  436.     (insert "END (* while " name " *);"))
  437.   (end-of-line 0)
  438.   (m2-tab))
  439.  
  440. (defun m2-export ()
  441.   "Insert EXPORT QUALIFIED expression."
  442.   (interactive)
  443.   (insert "EXPORT QUALIFIED "))
  444.  
  445. (defun m2-import ()
  446.   "Insert FROM IMPORT skeleton, prompting <module-name>."
  447.   (interactive)
  448.   (insert "FROM ")
  449.   (insert (read-string "Module: "))
  450.   (insert " IMPORT "))
  451.  
  452. (defun m2-begin-comment ()
  453.   "Insert the beginning of the comments."
  454.   (interactive)
  455.   (if (not (bolp))
  456.       (indent-to comment-column 0))
  457.   (insert "(*  "))
  458.  
  459. (defun m2-end-comment ()
  460.   "Insert the ending of the comments."
  461.   (interactive)
  462.   (if (not (bolp))
  463.       (indent-to end-comment-column))
  464.   (insert "*)"))
  465.  
  466. (defun m2-compile ()
  467.   "Compile a module."
  468.   (interactive)
  469.   (setq modulename (buffer-name))
  470.   (compile (concat m2-compile-command " " modulename)))
  471.  
  472. (defun m2-build ()
  473.   "Build a project by prompting name."
  474.   (interactive)
  475.   (setq modulename (buffer-name))
  476.   (if m2-project-name
  477.       (compile (concat m2-build-command " " m2-project-name))
  478.     (compile (concat m2-build-command " "
  479.              (setq m2-project-name (read-string "Name of executable: "
  480.                             modulename))))))
  481.  
  482. (defun m2-execute-monitor-command (command)
  483.   (let* ((shell shell-file-name)
  484.      (csh (equal (file-name-nondirectory shell) "csh")))
  485.     (call-process shell nil t t "-cf" (concat "exec " command))))
  486.  
  487. (defun m2-visit ()
  488.   "Make a visit to prompting module using redirections (require m2whereis program for redirection search)."
  489.   (interactive)
  490.   (let ((deffile nil)
  491.     (modfile nil)
  492.     modulename)
  493.     (save-excursion
  494.       (setq modulename
  495.         (read-string "Module name: "))
  496.       (switch-to-buffer "*Command Execution*")
  497.       (m2-execute-monitor-command (concat "m2whereis " modulename))
  498.       (goto-char (point-min))
  499.       (condition-case ()
  500.       (progn (re-search-forward "\\(.*\\.def\\) *$")
  501.          (setq deffile (buffer-substring (match-beginning 1)
  502.                          (match-end 1))))
  503.     (search-failed ()))
  504.       (condition-case ()
  505.       (progn (re-search-forward "\\(.*\\.mod\\) *$")
  506.          (setq modfile (buffer-substring (match-beginning 1)
  507.                          (match-end 1))))
  508.     (search-failed ()))
  509.       (if (not (or deffile modfile))
  510.       (error "I can find neither definition nor implementation of %s"
  511.          modulename)))
  512.     (cond (deffile
  513.         (find-file deffile)
  514.         (if modfile
  515.         (save-excursion
  516.           (find-file modfile))))
  517.       (modfile
  518.        (find-file modfile)))))
  519.  
  520. (defun m2-toggle ()
  521.   "Toggle between .mod and .def files for the module."
  522.   (interactive)
  523.   (cond ((string-equal (substring (buffer-name) -4) ".def")
  524.      (find-file-other-window
  525.       (concat (substring (buffer-name) 0 -4) ".mod")))
  526.     ((string-equal (substring (buffer-name) -4) ".mod")
  527.      (find-file-other-window
  528.       (concat (substring (buffer-name) 0 -4)  ".def")))
  529.     ((string-equal (substring (buffer-name) -3) ".mi")
  530.      (find-file-other-window
  531.       (concat (substring (buffer-name) 0 -3)  ".md")))
  532.     ((string-equal (substring (buffer-name) -3) ".md")
  533.      (find-file-other-window
  534.       (concat (substring (buffer-name) 0 -3)  ".mi")))))
  535.  
  536. ;;;======================================================================
  537. ;;; The stuff in this section relate to indentation.
  538.  
  539. (defun m2-indent-line ()
  540.   "Indent the current-line."
  541.   (interactive)
  542.   (m2-indent-line-work t))
  543.  
  544. (defun m2-indent-line-work (electric)
  545.   ;; If in unterminated string, give an error.  If in comment and
  546.   ;; electric, indent like previous line.
  547. ;;;  (message "indent-line-work") (sit-for 2)
  548.   (let ((string-comment-state (m2-in-comment-or-string)))
  549.     (cond
  550.      ((eq string-comment-state 'string)
  551.       (beep)
  552.       (message "Unterminated Text literal..."))
  553.      ((eq string-comment-state 'comment)
  554.       (if electric
  555.       (let ((cur-point (point)))
  556.         (beginning-of-line)
  557.         (m2-skip-whitespace-in-line)
  558.         (cond
  559.          ;; If the current line begines with a close comment,
  560.          ;; indent it to the level of the matching start comment.
  561.          ((save-excursion
  562.         (beginning-of-line)
  563.         (m2-skip-whitespace-in-line)
  564.         (looking-at "*)"))
  565.           (m2-indent-to
  566.            cur-point
  567.            (save-excursion
  568.          (beginning-of-line)
  569.          (m2-skip-whitespace-in-line)
  570.          (forward-char 2)
  571.          (m2-skip-comment-backward (point-min) t)
  572.          (current-column))))
  573.  
  574.          ;;; If the current line begins with an open-comment, and
  575.          ;;; the opened comment is not nested, indent like a code line.
  576.          ((save-excursion
  577.         (beginning-of-line)
  578.         (m2-skip-whitespace-in-line)
  579.         (and (looking-at "(*")
  580.              (not (m2-in-comment-or-string))))
  581.           (m2-indent-to cur-point (m2-indent-for-line)))
  582.  
  583.          ;;; Otherwise, indent to same level as previous
  584.          ;;; non-whitespace line.
  585.          (t
  586.           (m2-indent-to
  587.            cur-point
  588.            (save-excursion
  589.          (forward-line -1)
  590.          (while (looking-at m2-whitespace-line-re)
  591.            (forward-line -1))
  592.          (m2-skip-whitespace-in-line)
  593.          (if (looking-at "(\\*")
  594.              (progn (forward-char 2)
  595.                 (m2-skip-whitespace-in-line)))
  596.          (current-column))))))))
  597.  
  598.      ;; We're not in a comment or a string.  Indent the current line.
  599.      (t
  600.       (m2-indent-to (point) (m2-indent-for-line))
  601.       ;; Do the appropriate thing for electric end's.
  602.       (m2-do-electric-end)))))
  603.  
  604.  
  605. (defun m2-indent-for-line ()
  606.   (save-excursion
  607.     (beginning-of-line)
  608.     (let ((cur-point (point))
  609.       (part-start (save-excursion
  610.             (m2-backward-to-last-part-begin)
  611.             (point)))
  612.       (first-code
  613.        (save-excursion
  614.          (re-search-forward "[ \t]*"
  615.                 (save-excursion (end-of-line) (point))
  616.                 t)
  617.          (goto-char (match-end 0))
  618. ;;;         (message "first-code 2") (sit-for 2)
  619.          (point)))
  620.       ;; Must do this because Modula is case-sensitive
  621.       (case-fold-search nil))
  622.  
  623.       ;; Find end of previous statement or last keyword-line-starter.
  624. ;;;      (message "m2-indent-for-line(A)") (sit-for 2)
  625.  
  626.       (m2-re-search-backward
  627.        (concat "\\(;\\|^[ \t]*\\(" m2-keyword-line-starters "\\)\\)")
  628.        part-start t)
  629.       (while (m2-in-arg-list part-start)
  630.     (m2-re-search-backward
  631.      (concat "\\(;\\|^[ \t]*\\(" m2-keyword-line-starters "\\)\\)")
  632.      part-start t))
  633.       (cond
  634.        ((and (looking-at ";")
  635.          (save-excursion
  636.            (beginning-of-line)
  637.            (re-search-forward
  638.         (concat "^[ \t]*\\(" m2-keyword-line-starters "\\)")
  639.         (save-excursion (end-of-line) (point))
  640.         t)))
  641.     (beginning-of-line)
  642.     (re-search-forward "[ \t]*"))
  643.  
  644.        (t
  645.     ;; skip to the keyword;
  646.     (re-search-forward "[ \t]*")))
  647.  
  648. ;;;      (message "m2-indent-for-line(B)") (sit-for 2)
  649.  
  650.       ;; Now figure out if there is an intervening incomplete
  651.       ;; statement between here and the original line.
  652.       (let ((prev-statement-start (point)))
  653. ;;;    (message "Checking completeness") (sit-for 2)
  654.     (cond
  655.      ;; Is it incomplete?
  656.      ((m2-prev-line-incomplete-p cur-point part-start)
  657.  
  658.       ;; ...OK, the previous line *was* incomplete.
  659.       (goto-char cur-point)
  660. ;;;      (message "m2-indent-for-line: incomplete") (sit-for 2)
  661.       (m2-incomplete-indent cur-point first-code part-start))
  662.  
  663.      (t
  664.       ;; No: the previous line completed a statement, so find it's
  665.       ;; start and indent from that.
  666. ;;;      (message "m2-indent-for-line: complete") (sit-for 2)
  667.  
  668.       (let ((skip-one
  669.          (and (save-excursion
  670.             (goto-char first-code)
  671.             (looking-at m2-keyword-ssl-enders))
  672.               (save-excursion
  673.             (goto-char first-code)
  674.             (m2-re-search-backward
  675.              (concat "\\(" m2-keyword-endable-ssl-introducers
  676.                  "\\|;\\)")
  677.              part-start t)
  678.             (not (looking-at ";"))))))
  679.  
  680. ;;;        (message "m2-IFL complete(2): skip-one = %s" skip-one) (sit-for 2)
  681.         (goto-char cur-point)
  682.         (beginning-of-line)
  683.         (m2-re-search-backward
  684.          (concat "\\(;\\|END\\|\\("
  685.              m2-keyword-endable-ssl-introducers "\\|"
  686.              m2-part-starters "\\)\\)")
  687.          part-start 'move-to-limit)
  688. ;;;        (message "m2-IFL complete(2.5-1)") (sit-for 2)
  689.         (while (m2-in-arg-list part-start)
  690. ;;;          (message "m2-IFL complete(2.5-2)") (sit-for 2)
  691.           (m2-re-search-backward
  692.            (concat "\\(;\\|END\\|\\(" m2-keyword-endable-ssl-introducers
  693.                "\\|" m2-part-starters "\\)\\)")
  694.            part-start 'move-to-limit))
  695.  
  696.         ;; Should now be at the beginning of the last
  697.         ;; ';', END, comment-start on left margin, or ssl-introducer.
  698. ;;;        (message "m2-IFL complete(3)") (sit-for 2)
  699.         (cond
  700.          (skip-one
  701. ;;;          (message "m2-IFL skip-one(1)") (sit-for 2)
  702.           (if (looking-at ";") (error "Bad logic."))
  703.           (cond
  704.            ((looking-at (concat "^" m2-com-start-re))
  705. ;;;        (message "m2-IFL skip-one left-margin-commment") (sit-for 2)
  706.         0)
  707.            (t
  708.         (re-search-forward m2-keyword-line-starters (point-max) t)
  709.         (goto-char (match-end 0))
  710. ;;;        (message "m2-IFL skip-one(2)") (sit-for 2)
  711.         (let ((eol (save-excursion (end-of-line) (point))))
  712.           (m2-forward-to-code first-code)
  713. ;;;          (message "m2-IFL skip-one(3)") (sit-for 2)
  714.           (cond
  715.            ;; Is there stuff between the keyword and the current line?
  716.            ((and (> (point) eol) (< (point) first-code))
  717. ;;;            (message "m2-IFL: skip-1 indentation x") (sit-for 2)
  718.             (m2-complete-adjust-indent (current-column) first-code
  719.                            part-start))
  720.            ;; No;
  721.            (t
  722. ;;;            (message "m2-IFL: skip-1 indentation y0") (sit-for 2)
  723.             (m2-re-search-backward
  724.              (concat "^[ \t]*\\(" m2-keyword-line-starters "\\)")
  725.              part-start t)
  726.             (re-search-forward m2-keyword-line-starters first-code t)
  727.             (goto-char (match-beginning 0))
  728.             (cond
  729.              ((save-excursion
  730.             (beginning-of-line)
  731.             (looking-at (concat "[ \t]*" m2-multi-keyword-lines)))
  732.               (beginning-of-line)
  733.               (re-search-forward "[ \t]*" first-code t)
  734.               (goto-char (match-end 0))))
  735. ;;;            (message "m2-IFL: skip-1 indentation y") (sit-for 2)
  736.             (m2-after-keyword-adjust-indent
  737.              (current-column)
  738.              first-code part-start)))))))
  739.  
  740.          (t
  741. ;;;          (message "m2-IFL skip-two") (sit-for 2)
  742.           ;; First of all, are we in a procedure argument list?
  743.           (let ((in-arg-list (m2-in-arg-list part-start)))
  744.         (cond
  745.          ;; Are we at the beginning of the file?
  746.          ;; If so, move current line to left margin.
  747.          ((eq (save-excursion
  748.             (m2-backward-to-code (point-min))
  749. ;;;            (message "m2-IFL foo: %d" (point)) (sit-for 2)
  750.             (point))
  751.               1)
  752.           0)
  753.  
  754.          ;; Are we looking at a comment on the left margin?
  755.          ((looking-at (concat "^" m2-com-start-re))
  756.           0)
  757.  
  758.          ;; Is it a keyword starting a line?
  759.          ((save-excursion
  760.             (beginning-of-line)
  761.             (looking-at
  762.              (concat "[ \t]*\\(" m2-keyword-line-starters "\\|"
  763.                  m2-part-starters "\\)")))
  764. ;;;          (message "m2-IFL: after complete keyword") (sit-for 2)
  765.           (beginning-of-line)
  766.           (re-search-forward
  767.            (concat m2-keyword-line-starters "\\|" m2-part-starters)
  768.            (point-max) t)
  769.           (goto-char (match-beginning 0))
  770. ;;;          (message "m2-IFL: after complete keyword 2") (sit-for 2)
  771.           (m2-after-keyword-adjust-indent (current-column)
  772.                           first-code part-start))
  773.  
  774.          (t
  775.           ;; No; skip backwards another then forward-to-code
  776. ;;;          (message "m2-IFL: skip-two xxx") (sit-for 2)
  777.           (if (not
  778.                (looking-at
  779.             (concat m2-keyword-endable-ssl-introducers "\\|;")))
  780.               (error "Bad logic 2."))
  781.           (let ((last-complete (looking-at ";\\|END")))
  782.             (beginning-of-line)
  783.             (m2-re-search-backward
  784.              (concat "\\(;\\|END\\|\\("
  785.                  m2-keyword-endable-ssl-introducers "\\)\\)")
  786.              part-start 'move-to-limit)
  787. ;;;            (message "m2-IFL: skip-two xxx 2") (sit-for 2)
  788.             (while (and (not in-arg-list) (m2-in-arg-list part-start))
  789. ;;;              (message "m2-IFL: skip-two xxx 2.2") (sit-for 2)
  790.               (m2-re-search-backward
  791.                (concat "\\(;\\|END\\|\\("
  792.                    m2-keyword-line-starters "\\)\\)")
  793.                part-start t))
  794. ;;;            (message "m2-IFL: skip-two xxx 2.5") (sit-for 2)
  795.             (let ((continue t) (OF-end (point)))
  796.               (while (and (looking-at "OF") continue)
  797.             (if (re-search-backward
  798.                  "SET[ \t]*\\|ARRAY[ \t]*\\[[^]]*\\][ \t]*"
  799.                  part-start t)
  800.                 (cond
  801.                  ((eq (match-end 0) OF-end)
  802.                   (m2-re-search-backward
  803.                    (concat "\\(;\\|\\("
  804.                        m2-keyword-line-starters "\\)\\)")
  805.                    part-start t))
  806.                  (t (setq continue nil)))
  807.               (setq continue nil))))
  808.               
  809. ;;;            (message "m2-IFL: skip-two xxx 3") (sit-for 2)
  810.             ;; If we're at part-start, then that is the indentation
  811.             ;; (Since part-starts are not ssl-introducers?)
  812.             (if (or (not (eq (point) part-start))
  813.                 (looking-at m2-keyword-endable-ssl-introducers))
  814.             (progn
  815.               (re-search-forward
  816.                (concat "\\(;\\|END\\|\\("
  817.                    m2-keyword-endable-ssl-introducers "\\)\\)")
  818.                (point-max) t)
  819.               (goto-char (match-end 0))
  820. ;;;              (message "m2-IFL: skip-two xxx 4") (sit-for 2)
  821.               (m2-forward-to-code cur-point)))
  822.  
  823. ;;;            (message "m2-indent-for-line: indentation") (sit-for 2)
  824.             (cond
  825.              (last-complete
  826.               (m2-complete-adjust-indent (current-column) first-code
  827.                          part-start))
  828.              (t
  829.               (m2-after-keyword-adjust-indent (current-column)
  830.                               first-code part-start)
  831.               )))))))))))))))
  832.  
  833.  
  834.  
  835.  
  836. (defun m2-in-arg-list (part-start)
  837.   "Returns non-NIL iff the point is in a procedure or method argument
  838. list."
  839. ;;;  (message "m2-in-arg-list(1)") (sit-for 2)
  840.   (save-excursion
  841.     (let ((cur-point (point)))
  842.       (m2-re-search-backward "PROCEDURE\\|METHODS" part-start t)
  843.       (cond
  844.        ((looking-at "PROCEDURE")
  845.     (forward-word 1)
  846.     (m2-re-search-forward "([^*]" (point-max) t)
  847. ;;;    (message "m2-in-arg-list(3)") (sit-for 2)
  848.     (and (< (point) cur-point)
  849.          (condition-case err
  850.          (progn
  851.            (forward-sexp 1)
  852. ;;;           (message "m2-in-arg-list(4)") (sit-for 2)
  853.            (> (point) cur-point))
  854.            (error t))))
  855.  
  856.        ((looking-at "METHODS")
  857.     (let ((continue t) (res nil))
  858.       (while (and continue (< (point) cur-point))
  859.         (m2-re-search-forward "([^*]\\|END" (point-max) t)
  860. ;;;        (message "m2-in-arg-list(101)") (sit-for 2)
  861.         (cond
  862.          ((and (looking-at "([^*]") (< (point) cur-point))
  863. ;;;          (message "m2-in-arg-list(101.5)") (sit-for 2)
  864.           (condition-case err
  865.           (progn
  866.             (forward-sexp 1)
  867. ;;;            (message "m2-in-arg-list(102)") (sit-for 2)
  868.             (if (> (point) cur-point) (setq res t)))
  869.         (error
  870.          ;; No matching right paren, so must still be in arg list.
  871. ;;;         (message "m2-in-arg-list(103)") (sit-for 2)
  872.          (setq continue nil)
  873.          (setq res t))))
  874.          (t
  875. ;;;          (message "m2-in-arg-list(104)") (sit-for 2)
  876.           (setq continue nil))))
  877.       res))
  878.  
  879.        (t nil)))))
  880.           
  881.  
  882.  
  883. (defun m2-prev-line-incomplete-p (cur-point part-start)
  884. ;;;  (message "incomplete?") (sit-for 2)
  885.   (or
  886.    ;; Does the previous non-blank line end with an operator?
  887.    (save-excursion
  888. ;;;     (message "incomplete-1") (sit-for 2)
  889.      (goto-char cur-point)
  890.      (m2-backward-to-code part-start)
  891.      (or (looking-at "[+\\-*&#<,]")
  892.      (and (looking-at ">")
  893.           (save-excursion
  894.         (beginning-of-line)
  895. ;;;        (message "incomplete-1.1") (sit-for 2)
  896.         (not (looking-at
  897.               (concat "[ \t]*"
  898.                   m2-handler-start-re
  899.                   "[ \t]*\\($\\|(\\*\\)")))))
  900.      (and (looking-at "=")
  901.           (save-excursion
  902. ;;;        (message "incomplete-1.2") (sit-for 2)
  903.         (beginning-of-line)
  904. ;;;        (message "incomplete-1.21") (sit-for 2)
  905.         (and (not (looking-at
  906.                (concat "PROCEDURE.*=[ \t]*\\($\\|(\\*\\)")))
  907.              (not (m2-in-arg-list part-start)))))
  908.              
  909.      (and (> (point) 2)
  910.           (progn
  911.         (forward-char -2)
  912.         (or (looking-at
  913.              (concat m2-not-identifier-char-re "OR"))
  914.             (and
  915.              (> (point) 1)
  916.              (progn
  917.                (forward-char -1)
  918.                (looking-at
  919.             (concat m2-not-identifier-char-re
  920.                 "\(DIV\\|MOD\\|AND\\|NOT")))))))))
  921.  
  922.    (save-excursion
  923.      (goto-char cur-point)
  924.      (m2-backward-to-code part-start)
  925.      (forward-char 1)
  926. ;;;     (message "incomplete-1B1") (sit-for 2)
  927.      (let ((last-char (point)))
  928.        (beginning-of-line 1)
  929.        (and (re-search-forward
  930.          (concat "^[ \t]*\\(" m2-statement-keywords "\\)")
  931.          cur-point t)
  932.         (= last-char (match-end 0)))))
  933.  
  934.    (save-excursion
  935. ;;;     (message "incomplete-2") (sit-for 2)
  936.      (cond
  937.       ((looking-at "END;")
  938. ;;;       (message "incomplete-2.01") (sit-for 2)
  939.        (forward-char 4))
  940.       ((looking-at
  941.     (concat "END[ \t]*" m2-identifier-re "[ \t]*\\(;\\|\\.\\)"))
  942. ;;;       (message "incomplete-2.02") (sit-for 2)
  943.        (re-search-forward
  944.     (concat "END[ \t]*" m2-identifier-re "[ \t]*\\(;\\|\\.\\)")
  945.     (point-max) t)
  946.        (goto-char (match-end 0)))
  947.       ((looking-at m2-multi-keyword-line-prefix)
  948. ;;;       (message "incomplete-2.1") (sit-for 2)
  949.        (re-search-forward m2-multi-keyword-line-prefix (point-max) t)
  950.        (goto-char (match-end 0)))
  951.  
  952.       ((looking-at "PROCEDURE")
  953. ;;;       (message "incomplete-2.15") (sit-for 2)
  954.        (forward-word 1)
  955.        (m2-re-search-forward "([^*]" (point-max) t)
  956.        (let ((new-point (point)))
  957.      (save-excursion
  958.       (condition-case err
  959.           (forward-sexp 1)
  960.         (error (goto-char (point-max))))
  961. ;;;      (message "incomplete-2.15-2") (sit-for 2)
  962.       (and (< (point) cur-point)
  963.            (m2-re-search-forward "=" (point-max) t)
  964.            (progn
  965.          (forward-char 1)
  966.          (and (< (point) cur-point)
  967. ;;;              (message "incomplete-2.15-3") (sit-for 2)
  968.               (setq new-point (point))))))
  969.      (goto-char new-point)))
  970.  
  971.       ((looking-at "WITH")
  972. ;;;       (message "incomplete-2.191") (sit-for 2)
  973.        (forward-word 1)
  974.        (let ((new-point (point)))
  975.      (m2-re-search-forward "DO" first-code t)
  976. ;;;     (message "incomplete-2.192") (sit-for 2)
  977.      (cond
  978.       ((looking-at "DO")
  979.        (forward-word 1)
  980. ;;;       (message "incomplete-2.193") (sit-for 2)
  981.        (setq new-point (point))))
  982.      (goto-char new-point)))
  983.  
  984.       ((looking-at "END")
  985.        (forward-word 1)
  986.        (cond
  987.     ((save-excursion
  988.        (m2-forward-to-code (point-max))
  989.        (looking-at ";"))
  990.      (m2-forward-to-code (point-max))
  991.      (forward-char 1))))
  992.  
  993.       ;; If looking-at keyword-line-starter or part-starter
  994.       ((looking-at (concat m2-keyword-line-starters "\\|" m2-part-starters))
  995. ;;;       (message "incomplete-2.2") (sit-for 2)
  996.        (re-search-forward
  997.     (concat m2-keyword-line-starters "\\|" m2-part-starters)
  998.     (point-max) t)
  999.        (goto-char (match-end 0)))
  1000.  
  1001.       ((looking-at ";")
  1002.        (forward-char 1)))
  1003.  
  1004.      ;; Go forward to code.
  1005. ;;;     (message "m2-IFL: before codepoint") (sit-for 2)
  1006.      (m2-forward-to-code (point-max))
  1007.      ;; Is there something between the last ';' and the current
  1008.      ;; line?
  1009. ;;;     (message "m2-IFL: codepoint") (sit-for 2)
  1010.      (and
  1011.       (< (point) cur-point)
  1012.       ;; Yes -- means that the previous statement was incomplete...
  1013.  
  1014.       ;; ...unless the current line is an ssl-ender, in which
  1015.       ;; case it is assumed complete...
  1016. ;;;      (message "incomplete-3") (sit-for 2)
  1017.       (or (not
  1018.        (save-excursion
  1019.          (goto-char first-code)
  1020. ;;;         (message "incomplete-3.1") (sit-for 2)
  1021.          (looking-at m2-keyword-ssl-enders)))
  1022.       (save-excursion
  1023. ;;;        (message "incomplete-3.2") (sit-for 2)
  1024.         (goto-char first-code)
  1025.         (m2-backward-to-code part-start)
  1026.         (forward-char 1)
  1027. ;;;        (message "incomplete-3.21") (sit-for 2)
  1028.         (let ((after (point)))
  1029.           (m2-re-search-backward m2-keyword-endable-ssl-introducers
  1030.                      part-start t)
  1031.           (re-search-forward m2-keyword-endable-ssl-introducers
  1032.                  cur-point t)
  1033.           (goto-char (match-end 0))
  1034. ;;;          (message "incomplete-3.22") (sit-for 2)
  1035.           (= (point) after))))
  1036.  
  1037.       ;; ... or there is a an ssl-ender between here and first-code
  1038.       ;; that is not a semi in an argument list...
  1039.       (not (save-excursion
  1040. ;;;         (message "incomplete-3.3-0") (sit-for 2)
  1041.          (and (m2-re-search-forward
  1042.            (concat ";\\|" m2-keyword-ssl-enders)
  1043.            first-code 't)
  1044.           (let ((continue t))
  1045.             (while (and continue (m2-in-arg-list part-start))
  1046. ;;;              (message "incomplete-3.3-1") (sit-for 2)
  1047.               (re-search-forward
  1048.                (concat ";\\|" m2-keyword-ssl-enders)
  1049.                first-code 't)
  1050.               (goto-char (match-end 0))
  1051. ;;;              (message "incomplete-3.3-2") (sit-for 2)
  1052.               (setq continue
  1053.                 (m2-re-search-forward
  1054.                  (concat ";\\|" m2-keyword-ssl-enders)
  1055.                  first-code 't)))
  1056.             continue)
  1057. ;;;          (message "incomplete-3.3") (sit-for 2)
  1058.           (< (point) first-code))))
  1059.  
  1060.       ;; ... or the previous statement is a multi-keyword statement
  1061.       ;; and the current line is completed by a subsequent keyword...
  1062.       (not
  1063.        (save-excursion
  1064.      (goto-char cur-point)
  1065.      (m2-backward-to-non-comment-line-start part-start)
  1066. ;;;     (message "m2-indent-for-line: multi-keyword") (sit-for 2)
  1067.      (looking-at m2-multi-keyword-lines)))
  1068.       ))))
  1069.  
  1070.  
  1071.  
  1072. ;; Constants, especially helpful regexps.
  1073.  
  1074. (defconst m2-identifier-char-re "[a-zA-Z0-9_]")
  1075. (defconst m2-alpha-char-re "[a-zA-Z_]")
  1076. (defconst m2-not-identifier-char-re "[^a-zA-Z0-9_]")
  1077.  
  1078. (defconst m2-identifier-re
  1079.   (concat "\\b" m2-alpha-char-re m2-identifier-char-re "*\\b"))
  1080.  
  1081. (defconst m2-intlit-re "[1-9][0-9]*")
  1082.  
  1083. (defconst m2-poss-qual-ident-re
  1084.   (concat "\\(" "\\(" m2-identifier-re "\\.\\)?" m2-identifier-re "\\.\\)?"
  1085.       m2-identifier-re))
  1086.  
  1087. (defconst m2-com-start-re "\\((\\*\\|<\\*\\)")
  1088. (defconst m2-com-end-re "\\(\\*)\\|\\*>\\)")
  1089. (defconst m2-com-start-or-end-re
  1090.   (concat "\\\(" m2-com-start-re "\\|" m2-com-end-re "\\)"))
  1091.  
  1092. (defconst m2-whitespace-char-re "[ \t]")
  1093. (defconst m2-poss-whitespace-re "[ \t]*")
  1094. (defconst m2-poss-whitespace-nl-re "[ \t\n]*")
  1095. (defconst m2-whitespace-line-re "^[ \t\n]*$")
  1096.  
  1097.  
  1098. (defconst m2-char-lit-re "'\\([^\\]\\|\\\\..?.?\\)'")
  1099.  
  1100. (defconst m2-range-re
  1101.   (concat m2-intlit-re m2-poss-whitespace-re "\\.\\."
  1102.       m2-poss-whitespace-re m2-intlit-re))
  1103.   
  1104.   
  1105. (defconst m2-case-label-re
  1106.   (concat "\\(" m2-poss-qual-ident-re "\\|"
  1107.       m2-char-lit-re "\\|"
  1108.       m2-intlit-re "\\|"
  1109.       m2-range-re
  1110.       "\\)"))
  1111.  
  1112. (defconst m2-handler-start-re
  1113.   (concat "\\(|[ \t]*\\)?\\("
  1114.       (concat "\\b" m2-poss-qual-ident-re m2-poss-whitespace-re
  1115.           "(" m2-poss-whitespace-re m2-identifier-re
  1116.           m2-poss-whitespace-re ")" )
  1117.       "\\|"
  1118.       (concat "\\b" m2-case-label-re
  1119.           (concat "\\(" m2-poss-whitespace-re ","
  1120.               m2-poss-whitespace-nl-re m2-case-label-re "\\)*"))
  1121.       
  1122.       "\\)" m2-poss-whitespace-re "=>"))
  1123.  
  1124. (defconst m2-object-re
  1125.   (concat "\\(" m2-identifier-re "[ \t]+\\)?\\(BRANDED[ \t]+"
  1126.       "\\(\"[^\"]+\"\\)?[ \t]+\\)?OBJECT"))
  1127.  
  1128.  
  1129. (defconst m2-part-starters
  1130.   (concat
  1131.    "\\bINTERFACE\\b\\|\\bMODULE\\b\\|\\bIMPORT\\b\\|\\bFROM\\b\\|"
  1132.    "\\bTYPE\\b\\|\\bEXCEPTION\\b\\|\\bVAR\\b\\|"
  1133.    "\\bPROCEDURE\\b\\|\\bREVEAL\\b\\|\\bCONST\\b")
  1134.   "These are the patterns that can start lines and change the indentation
  1135. of the following line.")
  1136.  
  1137.  
  1138. (defconst m2-keyword-endable-ssl-introducers
  1139.   (concat
  1140.    "\\bTYPE\\b\\|\\bVAR\\b\\|"
  1141.    "\\bRECORD\\b\\|\\bOBJECT\\b\\|\\bMETHODS\\b\\|\\bOVERRIDES\\b\\|"
  1142.    "\\bBEGIN\\b\\|\\bTRY\\b\\|\\bEXCEPT\\b\\|"
  1143.    m2-handler-start-re "\\|"
  1144.    "\\bFINALLY\\b\\|\\bLOOP\\b\\|\\bTHEN\\b\\|\\bELSE\\b\\|\\bREPEAT\\b\\|"
  1145.    "\\bDO\\b\\|\\bOF\\b\\|\\bREVEAL\\b\\|\\bCONST\\b"))
  1146.  
  1147. ;;; These keywords have the property that they affect the indentation if they
  1148. ;;; occur at the beginning of a line.
  1149. (defconst m2-keyword-line-starters
  1150.   (concat
  1151.    "TYPE\\|\\bEND\\b\\|RECORD\\|PROCEDURE\\|OBJECT\\|METHODS\\|OVERRIDES\\|"
  1152.    "VAR\\|BEGIN\\|TRY\\|EXCEPT\\b\\|"
  1153.    m2-handler-start-re "\\|"
  1154.    "|\\|FINALLY\\|LOOP\\|THEN\\|ELSIF\\|IF\\|ELSE\\|WHILE\\|REPEAT\\|"
  1155.    "WITH\\|FOR\\b\\|DO\\|CASE\\|\\bOF\\b\\|TYPECASE\\|LOCK\\|CONST\\|FROM\\|"
  1156.    "REVEAL"))
  1157.  
  1158.  
  1159.  
  1160.  
  1161. (defconst m2-multi-keyword-line-prefix
  1162.   (concat
  1163.    "\\("
  1164.    ;; ...a PROCEDURE at the start of a line that ends
  1165.    ;; with an equals
  1166.    "^PROCEDURE[^\n]*=" "\\|"
  1167.    ;; ... or an IF or ELSEIF that ends with a THEN
  1168.    "\\(IF\\|ELSIF\\)[^\n]*THEN" "\\|"
  1169.    ;; ... or a WHILE, WITH, FOR, or LOCK that ends with a DO
  1170.    "\\(WHILE\\|WITH\\|FOR\\b\\|LOCK\\)[^\n]*DO" "\\|"
  1171.    ;; ... or a FOR that ends with a TO or BY
  1172.    "FOR[^\n]*\\(DO\\|BY\\)" "\\|"          
  1173.    ;; ... or a CASE or TYPECASE that ends with a OF
  1174.    "\\(CASE\\|TYPECASE\\)[^\n]*OF" "\\|"
  1175.    ;; ... or at a handler-start that ends with a "=>"
  1176.    "\\(|\\|\\)[ \t]*" m2-handler-start-re
  1177.    "\\)"
  1178.    ))
  1179.  
  1180. (defconst m2-multi-keyword-lines
  1181.   (concat m2-multi-keyword-line-prefix 
  1182.       "[ \t]*\\($\\|(\\*\\)"))
  1183.  
  1184.  
  1185. (defconst m2-statement-starters
  1186.   (concat
  1187.    "BEGIN\\b\\|TRY\\b\\|LOOP\\b\\|IF\\b\\|WHILE\\b\\|REPEAT\\b\\|"
  1188.    "WITH\\\b\\|FOR\\b\\|CASE\\b\\|TYPECASE\\b\\|LOCK\\b")
  1189.   
  1190.   "These are the patterns that can start lines and change the indentation
  1191. of the following line.")
  1192.  
  1193.  
  1194.  
  1195. (defconst m2-keyword-ssl-enders
  1196.   "|\\|EXCEPT\\|FINALLY\\|ELSIF\\|ELSE\\|UNTIL\\|END")
  1197.  
  1198. (defconst m2-left-parens
  1199.   "\\((\\|\\[\\|{\\)")
  1200. (defconst m2-right-parens
  1201.   "\\()\\|\\]\\|}\\)")
  1202.  
  1203. ;;; Think of a more descriptive name for these...
  1204.  
  1205. (defconst m2-statement-keywords
  1206.   "RETURN\\|RAISE\\|EXCEPTION\\|IMPORT\\|WITH")
  1207.  
  1208.  
  1209. ;; Variables that control indentation behavior
  1210.  
  1211. (defvar m2-standard-offset 2)
  1212. (defvar m2-continued-line-offset 2)
  1213. (defvar m2-case-offset 0)
  1214. ;;;(setq m2-case-offset 2)
  1215. (defvar m2-open-paren-offset 4)
  1216. ;;;(setq m2-open-paren-offset 2)
  1217. (defvar m2-assign-offset 4)
  1218. (defvar m2-RAISES-offset 4)
  1219.  
  1220. (defvar m2-follow-continued-indent t)
  1221.  
  1222. (defvar m2-END-undent 2)
  1223. (defvar m2-METHODS-undent 2)
  1224. (defvar m2-OVERRIDES-undent 2)
  1225. (defvar m2-EXCEPT-undent 2)
  1226. (defvar m2-VERT-undent 2)
  1227. (defvar m2-handler-start-undent 0)
  1228. (defvar m2-EXCEPT-undent 2)
  1229. (defvar m2-UNTIL-undent 2)
  1230. (defvar m2-FINALLY-undent 2)
  1231. (defvar m2-ELSIF-undent 2)
  1232. (defvar m2-ELSE-undent 2)
  1233.  
  1234. (defvar m2-DO-undent 1)
  1235. (defvar m2-OF-undent 1)
  1236. (defvar m2-THEN-undent 1)
  1237.  
  1238. (defvar m2-OBJECT-undent 1)
  1239. (defvar m2-RECORD-undent 1)
  1240.  
  1241.  
  1242.  
  1243. (defun m2-after-keyword-adjust-indent (indent first-code part-start)
  1244.   "Point is looking at a keyword at column INDENT; if the current line has
  1245. any code it starts at FIRST-CODE.  Return the proper indentation for the
  1246. current line."
  1247. ;;;  (message "m2-after-keyword: indent = %d" indent) (sit-for 2)
  1248.   (let ((call-adjust-indent t))
  1249.     (cond
  1250.      ((looking-at "END")
  1251. ;;;    (message "m2-after-keyword(END): i: %d, m2-END: %d, m2-stand: %d"
  1252. ;;;         indent m2-END-undent m2-standard-offset)
  1253. ;;;    (sit-for 2)
  1254.       (setq indent (- (+ indent m2-END-undent) m2-standard-offset)))
  1255.  
  1256.      ((looking-at "ELSE")
  1257.       (setq indent (+ indent m2-ELSE-undent))
  1258.       (if (m2-in-case part-start)
  1259.       (setq indent (+ indent m2-case-offset))))
  1260.     
  1261.  
  1262.      ((looking-at "METHODS")
  1263.       (setq indent (+ indent m2-METHODS-undent)))
  1264.      ((looking-at "OVERRIDES")
  1265.       (setq indent (+ indent m2-OVERRIDES-undent)))
  1266.      ((looking-at "EXCEPT\\b")
  1267. ;;;    (message "m2-after-keyword: EXCEPT" indent) (sit-for 2)
  1268.       (setq indent (+ indent m2-EXCEPT-undent)))
  1269.      ((looking-at "|")
  1270. ;;;    (message "m2-after-keyword: vert" indent) (sit-for 2)
  1271.       (setq indent (+ indent m2-VERT-undent m2-case-offset)))
  1272.      ((looking-at m2-handler-start-re)
  1273. ;;;      (message "m2-after-keyword: handler-start" indent) (sit-for 2)
  1274.       (setq indent (+ indent m2-handler-start-undent m2-case-offset)))
  1275.      ((looking-at "FINALLY")
  1276.       (setq indent (+ indent m2-FINALLY-undent)))
  1277.      ((looking-at "THEN")
  1278.       (setq indent (+ indent m2-THEN-undent)))
  1279.      ((looking-at "ELSIF")
  1280.       (setq indent (+ indent m2-ELSIF-undent)))
  1281.      ((looking-at "ELSE")
  1282.       (setq indent (+ indent m2-ELSE-undent)))
  1283.      ((looking-at "DO")
  1284.       (setq indent (+ indent m2-DO-undent)))
  1285.      ((looking-at "OF")
  1286.       (setq indent (+ indent m2-OF-undent)))
  1287.      ((looking-at m2-object-re)
  1288.       (setq indent (+ indent m2-OBJECT-undent)))
  1289.      ((looking-at "RECORD")
  1290.       (setq indent (+ indent m2-RECORD-undent)))
  1291.  
  1292.      ;; These are the keywords that can be followed by an SSL that begins on
  1293.      ;; the same line -- if so, indent to the level of the first elem.
  1294.      ((looking-at m2-same-line-ssl-keywords)
  1295. ;;;      (message "m2-after-keyword: same-line-ssl") (sit-for 2)
  1296.       (let ((eol (save-excursion (end-of-line 1) (point))))
  1297.     (save-excursion
  1298.       (forward-word 1)
  1299.       (m2-forward-to-code (point-max))
  1300. ;;;      (message "m2-after-keyword: SlSSL(2)") (sit-for 2)
  1301.       (cond
  1302.        ((and
  1303.          m2-follow-continued-indent
  1304.          (<= (point) eol)
  1305.          (save-excursion
  1306.            (goto-char first-code)
  1307.            (not (looking-at (concat m2-part-starters "\\|BEGIN"))))
  1308.          (save-excursion
  1309.            (end-of-line 1)
  1310.            (m2-backward-to-code part-start)
  1311.            (looking-at ";")))
  1312. ;;;        (message "m2-after-keyword: SLSSL (3)") (sit-for 2)
  1313.         (setq indent (current-column))
  1314.         (setq call-adjust-indent nil))
  1315.        (t
  1316.         (setq indent (+ indent m2-standard-offset)))))))
  1317.  
  1318.      ;; These are all the keywords that don't affect the indentation
  1319.      ;; when they start complete lines.
  1320.      ((looking-at
  1321.        (concat "INTERFACE\\|MODULE\\|IMPORT\\|FROM\\|EXCEPTION"))
  1322. ;;;    (message "m2-after-keyword: no extra") (sit-for 2)
  1323.       indent)
  1324.  
  1325.      ;; Otherwise, give the standard indentation.
  1326.      (t
  1327. ;;;    (message "m2-after-keyword: standard") (sit-for 2)
  1328.       (setq indent (+ indent m2-standard-offset))))
  1329.     
  1330.     (cond
  1331.      (call-adjust-indent
  1332.       (save-excursion
  1333.     (goto-char first-code)
  1334. ;;;    (message "m2-after-keyword: calling complete-adjust") (sit-for 2)
  1335.     (m2-complete-adjust-indent indent first-code part-start)))
  1336.      (t
  1337. ;;;      (message "m2-after-keyword: not calling complete-adjust") (sit-for 2)
  1338.       indent))))
  1339.  
  1340.  
  1341. (defun m2-in-case (part-start)
  1342. ;;;  (message "M2-in-case") (sit-for 2)
  1343.   (save-excursion
  1344.     (let ((cur-point (point)))
  1345.       (m2-backward-to-end-match part-start)
  1346. ;;;      (message "M2-in-case(2)") (sit-for 2)
  1347.       (and
  1348.        (looking-at m2-case-starters)
  1349.        (progn
  1350.      (cond
  1351.       ((looking-at "TRY")
  1352.        ;; Is it a TRY-FINALLY or a TRY-EXCEPT?
  1353.        (let (res (continue t))
  1354.          (while continue
  1355.            (setq res (m2-re-search-forward "TRY\\|EXCEPT\\|FINALLY"
  1356.                          cur-point t))
  1357.            (cond
  1358.         ((looking-at "EXCEPT")
  1359.          (setq continue nil))
  1360.         ((looking-at "TRY")
  1361.          ;; Go to matchine END and try again
  1362.          (m2-forward-to-end-matcher cur-point))
  1363.         (t;; FINALLY or not found
  1364.          (setq res nil)
  1365.          (setq continue nil))))
  1366.          res))
  1367.       (t t)))
  1368.        ;;; We are now looking at a case starter.  Make sure there is
  1369.        ;;; at least one case arm starter.
  1370.        (progn
  1371.      (cond
  1372.       ((looking-at "EXCEPT") (forward-word 1))
  1373.       ((looking-at "CASE\\|TYPECASE")
  1374.        (forward-word 1)
  1375.        (m2-re-search-forward "OF" cur-point 'move-to-limit)
  1376.        (forward-word 1)))
  1377.      (m2-forward-to-code cur-point)
  1378. ;;;     (message "M2-in-case: about to test handler") (sit-for 2)
  1379.      (and (< (point) cur-point)
  1380.           (looking-at m2-handler-start-re)))
  1381.  
  1382. ;;;       (message "M2-in-case: returning t") (sit-for 2)
  1383.        ))))
  1384.  
  1385.      
  1386. (defun m2-in-continued-record-def (part-start)
  1387.   (if (not (looking-at "END"))
  1388.       (error "m2-in-continued-record-def assumes looking-at END"))
  1389.   (save-excursion
  1390.     (m2-backward-to-end-match part-start)
  1391.     (let ((end-match (point)) (eol (save-excursion (end-of-line) (point))))
  1392.       (beginning-of-line)
  1393.       (or (save-excursion
  1394.         (re-search-forward "[ \t]*" eol t)
  1395.         (= (point) end-match))
  1396.       (save-excursion
  1397.         (and
  1398.          (re-search-forward "[ \t]*BRANDED[ \t]+" eol t)
  1399.          (= (point) end-match)
  1400.          (save-excursion
  1401.            (goto-char end-match)
  1402.            (looking-at "OBJECT"))))))))
  1403.  
  1404.      
  1405. (defun m2-correct-for-trailing-ends (indent part-start)
  1406.   ;; If the previous line ends in a (series of) END(s) that does
  1407.   ;; (do) not start the line, and are unmatched by the start of the line,
  1408.   ;; subtract the END-undent(s) from indent (the Eric Muller convention.)
  1409. ;;;  (message "correct-for-trailing-ends in: %d" indent) (sit-for 2)
  1410.   (let ((prev-line-start
  1411.      (save-excursion
  1412.        (m2-backward-to-code part-start)
  1413.        (beginning-of-line)
  1414.        (m2-forward-to-code (point-max))
  1415. ;;;       (message "correct-for-trailing-ends (0)") (sit-for 2)
  1416.        (point))))
  1417.     (save-excursion
  1418.       (if (save-excursion
  1419.         (m2-backward-to-code part-start)
  1420.         (beginning-of-line)
  1421.         (not (looking-at "[ \t]*END")))
  1422.       (save-excursion
  1423.         (let ((continue t))
  1424.           (while continue
  1425.         (m2-backward-to-code part-start)
  1426. ;;;        (message "correct-for-trailing-ends (2)") (sit-for 2)
  1427.         (cond
  1428.          ((or (and (> (point) 2)
  1429.                (progn
  1430.                  (forward-char -2) (looking-at "END")))
  1431.               (and (> (point) 1)
  1432.                (progn
  1433.                  (forward-char -1) (looking-at "END;"))))
  1434. ;;;          (message "correct-for-trailing-ends (3)") (sit-for 2)
  1435.           (if (not (looking-at "END"))
  1436.               (error "m2-complete-adjust-indent(A)"))
  1437.           (let ((em-point
  1438.              (save-excursion
  1439.                (m2-backward-to-end-match part-start)
  1440. ;;;               (message "correct-for-trailing-ends EM") (sit-for 2)
  1441.                (point))))
  1442. ;;;            (message "xxx") (sit-for 2)
  1443.             (cond
  1444.               ((< em-point prev-line-start)
  1445.                (goto-char prev-line-start)
  1446. ;;;               (message "xxx<") (sit-for 2)
  1447.                (setq indent
  1448.                  (save-excursion (goto-char em-point)
  1449.                          (current-column))))
  1450.               ((= em-point prev-line-start)
  1451. ;;;               (message "xxx=") (sit-for 2)
  1452.                (setq indent (- indent m2-END-undent))
  1453.                (setq continue nil))
  1454.               ((> em-point prev-line-start)
  1455.                (goto-char em-point)))))
  1456.          (t
  1457.           (setq continue nil))))))))
  1458. ;;;    (message "m2-trailing-end returns %d" indent) (sit-for 2)
  1459.     indent))
  1460.      
  1461.  
  1462. (defun m2-complete-adjust-indent (indent first-code part-start)
  1463.   "Previous statement is complete and starts at column INDENT;
  1464. if the current line has any code it starts at FIRST-CODE.  Returns the
  1465. proper indentation for the current line."
  1466. ;;;  (message "m2-complete-adjust(A): indent = %d, first-code = %d"
  1467. ;;;       indent first-code)
  1468. ;;;  (sit-for 2)
  1469.   (save-excursion
  1470.     (goto-char first-code)
  1471. ;;;    (message "m2-complete-adjust(B)") (sit-for 2)
  1472.  
  1473.     ;; If the previous line ends in a (series of) END(s) that does
  1474.     ;; (do) not start the line, and are unmatched before the start of the line,
  1475.     ;; the END-undent(s) (the Eric Muller convention.)
  1476.     (setq indent (m2-correct-for-trailing-ends indent part-start))
  1477.           
  1478. ;;;    (message "yyy2: indent = %d" indent) (sit-for 2)
  1479.     (cond
  1480.      ;; Some things can only start parts, and must be on the left margin.
  1481.      ((looking-at (concat "TYPE\\b\\|REVEAL\\b\\|EXCEPTION\\b\\|"
  1482.               "FROM\\b\\|IMPORT\\b"))
  1483.       0)
  1484.       
  1485.      ;; These can start parts, but can also appear in the procedures.
  1486.      ((looking-at
  1487.        (concat "\\(PROCEDURE\\b\\|CONST\\b\\|VAR\\b\\|BEGIN\\b\\)"))
  1488.       ;; Look backwards for line-beginning-keywords that increase the
  1489.       ;; indentation, start an SSL, but don't require an END (i.e.,
  1490.       ;; TYPE, VAR, or CONST); or END's.  If the former is found first,
  1491.       ;; decrease the indentation to the same as the keyword line's.
  1492.       ;; If an END is found whose matcher is not something that can
  1493.       ;; occur in a TYPE, VAR, or CONST (i.e. RECORD or OBJECT),
  1494.       ;; indent normally.
  1495. ;;;      (message "yyy7") (sit-for 2)
  1496.       (let ((new-indent indent) (continue t))
  1497.     (while continue
  1498. ;;;      (message "xxx1") (sit-for 2)
  1499.       (m2-re-search-backward
  1500.        (concat "\\(^[ \t]*\\(" m2-same-line-ssl-keywords "\\)\\|END\\|"
  1501.            m2-statement-starters "\\)")
  1502.        part-start 'move-to-limit)
  1503. ;;;      (message "xxx2") (sit-for 2)
  1504.       (cond
  1505.        ;; If we reached the part-start because of the move-to-limit,
  1506.        ;; indent to here...
  1507.        ((looking-at (concat "^" m2-part-starters))
  1508. ;;;        (message "xxx2.5") (sit-for 2)
  1509.         (goto-char first-code)
  1510.         ;; If its the start of a procedure def, indent normally.
  1511.         ;; Otherwise, indent to left margin.
  1512.         (if (not (m2-after-procedure-introducer part-start))
  1513.         (setq new-indent 0))
  1514.         (setq continue nil))
  1515.           
  1516.        ((and
  1517.          (looking-at
  1518.           (concat "^[ \t]*\\(" m2-same-line-ssl-keywords "\\)"))
  1519.          (not (m2-in-arg-list part-start)))
  1520.         (setq continue nil)
  1521.  
  1522.         ;;; To accomodate part-starters that establish new indentations,
  1523.         ;;; indent to the level of the previous part-starter, unless
  1524.         ;;; that was a BEGIN.
  1525.         (goto-char first-code)
  1526.         (m2-re-search-backward
  1527.          (concat m2-part-starters "\\|BEGIN") part-start t)
  1528.         (while (m2-in-arg-list part-start)
  1529.           (m2-re-search-backward
  1530.            (concat m2-part-starters "\\|BEGIN") part-start t))
  1531. ;;;        (message "xxx3") (sit-for 2)
  1532.         (cond
  1533.          ((looking-at "BEGIN")
  1534.           (setq new-indent (- new-indent m2-standard-offset)))
  1535.          (t
  1536.           (setq new-indent (current-column)))))
  1537.          
  1538.        ((looking-at
  1539.          (concat "END[ \t]*" m2-identifier-re "[ \t]*;"))
  1540.         (setq continue nil)
  1541.         (setq new-indent (- new-indent m2-standard-offset)))
  1542.  
  1543.  
  1544.        ((looking-at "END")
  1545.         (m2-backward-to-end-match part-start)
  1546. ;;;        (message "xxxEND-match") (sit-for 2)
  1547.         (cond
  1548.          ((looking-at "\\(RECORD\\|OBJECT\\)")
  1549.           nil)
  1550.          (t
  1551.           (setq continue nil))))
  1552.  
  1553.        (t
  1554.         (setq continue nil))))
  1555.     new-indent))
  1556.  
  1557.      ;; If the current line is an END, add the END-undent.
  1558.      ((looking-at "END")
  1559. ;;;      (message "zzz1") (sit-for 2)
  1560.       (cond
  1561.        ((m2-in-case part-start)
  1562.     (- indent m2-END-undent m2-case-offset))
  1563.        (t
  1564.     (- indent m2-END-undent))))
  1565.  
  1566.  
  1567.      ((looking-at "ELSE")
  1568.       (- indent m2-ELSE-undent
  1569.      (if (m2-in-case part-start) m2-case-offset 0)))
  1570.  
  1571.      ((looking-at "METHODS")
  1572.       (- indent m2-METHODS-undent))
  1573.      ((looking-at "OVERRIDES")
  1574.       (- indent m2-OVERRIDES-undent))
  1575.      ((looking-at "EXCEPT")
  1576.       (- indent m2-EXCEPT-undent))
  1577.      ((looking-at "UNTIL")
  1578.       (- indent m2-UNTIL-undent))
  1579.      ((looking-at "|")
  1580.       (cond
  1581.        ((save-excursion
  1582.       (m2-backward-to-code part-start)
  1583. ;;;      (message "zzz2") (sit-for 2)
  1584.       (or
  1585.        (save-excursion
  1586.          (and (> (point) 1)
  1587.           (progn (forward-char -1) (looking-at "OF"))))
  1588.        (save-excursion
  1589.          (and (> (point) 5)
  1590.           (progn (forward-char -5) (looking-at "EXCEPT"))))))
  1591.     (- indent m2-VERT-undent))
  1592.        (t
  1593.     (- indent m2-VERT-undent m2-case-offset))))
  1594.  
  1595.      ((looking-at "FINALLY")
  1596.       (- indent m2-FINALLY-undent))
  1597.      ((looking-at "THEN")
  1598.       (- indent m2-THEN-undent))
  1599.      ((looking-at "ELSIF")
  1600.       (- indent m2-ELSIF-undent))
  1601.      ((looking-at "ELSE")
  1602.       (- indent m2-ELSE-undent))
  1603.      ((looking-at "DO")
  1604.       (- indent m2-DO-undent))
  1605.      ((looking-at "OF")
  1606.       (- indent m2-OF-undent))
  1607.      ((looking-at "RECORD")
  1608. ;;;      (message "zzz-record") (sit-for 2)
  1609.       (- indent m2-RECORD-undent))
  1610.      ((looking-at m2-object-re)
  1611. ;;;      (message "zzz-object") (sit-for 2)
  1612.       (- indent m2-OBJECT-undent))
  1613.      (t
  1614. ;;;      (message "zzz-t: indent = %d" indent) (sit-for 2)
  1615.       indent))))
  1616.   
  1617.  
  1618. (defun m2-incomplete-indent (cur-point first-code part-start)
  1619.   (let* (list-indent
  1620.      (prev-line-start
  1621.       (save-excursion
  1622.         (m2-backward-to-non-comment-line-start part-start)
  1623.         (point)))
  1624.      (last-char-prev-line
  1625.       (save-excursion
  1626.         (m2-backward-to-non-comment-line-start part-start)
  1627.         (end-of-line)
  1628.         (m2-backward-to-code
  1629.          (save-excursion (beginning-of-line) (point)))
  1630.         (point)))
  1631.      (prev-line-indent
  1632.       (save-excursion
  1633.         (m2-backward-to-non-comment-line-start part-start)
  1634.         (let ((pli (current-column)))
  1635.           (cond
  1636.            ((looking-at m2-statement-keywords)
  1637.         (forward-word 1)
  1638.         (m2-forward-to-code first-code)
  1639.         (cond
  1640.          ((<= (point) last-char-prev-line)
  1641.           (current-column))
  1642.          (t pli)))
  1643.            (t pli))))))
  1644. ;;;    (message "m2-incomplete-indent(A)") (sit-for 2)
  1645.     (cond
  1646.      ;; Did the previous non-blank line end with a paren?
  1647.      ((save-excursion
  1648.     (goto-char last-char-prev-line)
  1649.     (looking-at m2-left-parens))
  1650.  
  1651. ;;;      (message "m2-incomplete-indent(PAREN)") (sit-for 2)
  1652.       ;;   Find the indentation of the previous line,
  1653.       ;;     either add open-paren-offset, or indent of paren +
  1654.       ;;     open-paren-sep
  1655.       (goto-char last-char-prev-line)
  1656.       (cond
  1657.        (m2-open-paren-offset
  1658. ;;;    (message "m2-incomplete-indent(PAREN offset)") (sit-for 2)
  1659.     (re-search-backward
  1660.      (concat m2-identifier-re m2-poss-whitespace-re)
  1661.      part-start t)
  1662.     (goto-char (match-beginning 0))
  1663.     ;; Account for qualified names.
  1664.     (cond
  1665.      ((save-excursion
  1666.         (and (> (point) 1)
  1667.          (progn
  1668.            (forward-char -1)
  1669.            (looking-at "\\."))))
  1670.       (re-search-backward
  1671.        (concat m2-identifier-re m2-poss-whitespace-re)
  1672.        part-start t)
  1673.       (goto-char (match-beginning 0))))
  1674.  
  1675. ;;;    (message "m2-incomplete-indent(PAREN offset 2)") (sit-for 2)
  1676.     (+ (current-column) m2-open-paren-offset))
  1677.        (t
  1678.     (+ (current-column) m2-open-paren-sep))))
  1679.         
  1680.      ;; Did the previous line end with a ',' or ';'?:
  1681.      ((save-excursion
  1682.     (goto-char last-char-prev-line)
  1683.     (looking-at ",\\|;"))
  1684.  
  1685. ;;;      (message "m2-incomplete-indent(COMMA)") (sit-for 2)
  1686.       ;; Skip over any matched parens; if this puts us at a line
  1687.       ;; containing an unmatched left paren, indent to that +
  1688.       ;; paren-sep.  Otherwise, indent same as beginning of that line.
  1689.       (save-excursion
  1690.     (goto-char last-char-prev-line)
  1691.     (let ((continue t) res)
  1692.       (while continue
  1693. ;;;        (message "m2-incomplete-indent(COMMA) 0") (sit-for 2)
  1694.         (m2-re-search-backward
  1695.          (concat m2-left-parens "\\|" m2-right-parens)
  1696.          (save-excursion (beginning-of-line)
  1697.                  (point)) 'move-to-limit)
  1698. ;;;        (message "m2-incomplete-indent(COMMA) 1") (sit-for 2)
  1699.         (cond
  1700.          ((looking-at m2-left-parens)
  1701. ;;;          (message "m2-incomplete-indent(COMMA) lp") (sit-for 2)
  1702.           (setq continue nil)
  1703.           (forward-char 1)
  1704.           (re-search-forward "[ \t]*") (goto-char (match-end 0))
  1705.           (setq list-indent (current-column)))
  1706.          ((looking-at m2-right-parens)
  1707. ;;;          (message "m2-incomplete-indent(COMMA) rp") (sit-for 2)
  1708.           (forward-char 1)
  1709.           (backward-sexp 1))
  1710.          (t
  1711. ;;;          (message "m2-incomplete-indent(COMMA) none") (sit-for 2)
  1712.           (beginning-of-line)
  1713.           (m2-forward-to-code last-char-prev-line)
  1714.           (setq continue nil)
  1715.           (setq list-indent (current-column)))))
  1716. ;;;      (message "m2-incomplete-indent(COMMA) end") (sit-for 2)
  1717.       (cond
  1718.        ((looking-at (concat "|[ \t]*" m2-identifier-char-re))
  1719.         (forward-word 1) (forward-word -1)
  1720.         (setq list-indent (current-column)))
  1721.        ((looking-at m2-statement-keywords)
  1722.         (forward-word 1)
  1723.         (re-search-forward "[ \t]*" last-char-prev-line t)
  1724.         (setq list-indent (current-column))))))
  1725.       list-indent)
  1726.           
  1727.      ;; Did the previous non-blank line end a procedure header?
  1728.      ((m2-after-procedure-introducer part-start)
  1729. ;;;      (message "m2-incomplete-indent(PROCEDURE)") (sit-for 2)
  1730.       (goto-char last-char-prev-line)
  1731.       (m2-re-search-backward "PROCEDURE" part-start t)
  1732.       (+ (current-column) m2-standard-offset))
  1733.  
  1734.      ;; Does the current line start a RAISES clause?
  1735.      ((looking-at "^[ \t]*RAISES")
  1736. ;;;      (message "m2-incomplete-indent(RAISES)") (sit-for 2)
  1737.       (goto-char last-char-prev-line)
  1738.       (m2-re-search-backward "PROCEDURE" part-start t)
  1739.       (+ (current-column) m2-RAISES-offset))
  1740.  
  1741.      ;; Did the previous line end with an assignment?
  1742.      ((save-excursion
  1743.     (goto-char last-char-prev-line)
  1744.     (beginning-of-line)
  1745. ;;;    (message "m2-incomplete-indent(:= 1)") (sit-for 2)
  1746.     (and (m2-re-search-forward ":=" (1+ last-char-prev-line) t)
  1747.          (re-search-forward "[^ \t]" last-char-prev-line t)))
  1748. ;;;      (message "m2-incomplete-indent(:=)") (sit-for 2)
  1749.       (goto-char last-char-prev-line)
  1750.       (beginning-of-line)
  1751.       (m2-re-search-forward ":=" last-char-prev-line t)
  1752.       (forward-char 2)
  1753.       (re-search-forward "[ \t]*[^ \t]")
  1754.       (+ (- (current-column) 1) m2-assign-offset))
  1755.  
  1756.      ;; Otherwise:
  1757.      (t
  1758. ;;;      (message "m2-incomplete-indent(OTHER)") (sit-for 2)
  1759.       ;; Find out if the previous line begins the statement.
  1760.       (goto-char prev-line-start)
  1761.       (m2-re-search-backward
  1762.        (concat ";\\|" m2-keyword-line-starters "\\|" m2-part-starters
  1763.            "\\|" m2-statement-keywords)
  1764.        part-start t)
  1765.       (while (m2-in-arg-list part-start)
  1766.     (m2-re-search-backward
  1767.      (concat ";\\|" m2-keyword-line-starters "\\|" m2-part-starters
  1768.          "\\|" m2-statement-keywords)
  1769.      part-start t))
  1770. ;;;      (message "m2-incomplete-indent(OTHER1)") (sit-for 2)
  1771.       (if (or (> (point) part-start)
  1772.           (and (= (point) part-start)
  1773.            (looking-at m2-keyword-endable-ssl-introducers)))
  1774.       (progn
  1775.         (re-search-forward
  1776.          (concat ";\\|" m2-keyword-line-starters "\\|" m2-part-starters
  1777.              "\\|" m2-statement-keywords)
  1778.          cur-point t)
  1779.         (goto-char (match-end 0))))
  1780. ;;;      (message "m2-incomplete-indent(OTHER1.5)") (sit-for 2)
  1781.       (m2-forward-to-code (point-max))
  1782. ;;;      (message "m2-incomplete-indent(OTHER2), prev-line-start = %d"
  1783. ;;;           prev-line-start)
  1784. ;;;      (sit-for 2)
  1785.       (cond
  1786.        ;; If the previous line begins the statement, add
  1787.        ;; m2-standard-offset to indentation, unless the prev-line-indent
  1788.        ;; has already skipped over a keyword.
  1789.        ((= (point) prev-line-start)
  1790. ;;;    (message "m2-incomplete-indent(START): prev-line-indent = %d"
  1791. ;;;         prev-line-indent)
  1792. ;;;    (sit-for 2)
  1793.     (m2-complete-adjust-indent
  1794.      ;; Indent further if we haven't indented already.
  1795.      (cond
  1796.       ((= prev-line-indent
  1797.           (save-excursion (goto-char prev-line-start) (current-column)))
  1798.        (+ prev-line-indent m2-continued-line-offset))
  1799.       (t prev-line-indent))
  1800.      first-code part-start))
  1801.        (t
  1802. ;;;    (message "m2-incomplete-indent(CONT)") (sit-for 2)
  1803.     ;; Otherwise, same indentation as previous, modulo adjustment
  1804.     ;; for current line
  1805.     prev-line-indent))))))
  1806.  
  1807.  
  1808. (defun m2-after-procedure-introducer (part-start)
  1809.   "Returns t iff first non-blank non-comment character before point is the '='
  1810. of a procedure definition."
  1811.   (save-excursion
  1812.     (m2-backward-to-code part-start)
  1813.     (and
  1814.      (looking-at "=")
  1815. ;;;     (message "m2-API(0)") (sit-for 2)
  1816.      (let ((eq-point (point)))
  1817.        (and
  1818.     ;; Not that this does not allow any comments in
  1819.     ;;   PROCEDURE Foo <left-paren>
  1820.     ;; and all must occur on the same line.
  1821.     (m2-re-search-backward
  1822.      (concat "PROCEDURE[ \t]*" m2-identifier-re "[ \t]*(")
  1823.      part-start t)
  1824. ;;;    (message "m2-API(1)") (sit-for 2)
  1825.     (progn
  1826.       (re-search-forward
  1827.        (concat "PROCEDURE[ \t]*" m2-identifier-re "[ \t]*(")
  1828.        eq-point t)
  1829.       (goto-char (match-end 0))
  1830. ;;;      (message "m2-API(2)") (sit-for 2)
  1831.       (forward-char -1)
  1832.       (and
  1833.        (condition-case err
  1834.            (progn (forward-sexp 1) t)
  1835.          (error nil))
  1836. ;;;       (message "m2-API(3)") (sit-for 2)
  1837.        ;; We should now be at the right paren of the arg-list.
  1838.        ;; Check for a return type.
  1839.        (progn
  1840.          (m2-forward-to-code eq-point)
  1841.          (and
  1842. ;;;          (message "m2-API(4)") (sit-for 2)
  1843.           (cond
  1844.            ((looking-at ":")
  1845.         (forward-char 1)
  1846.         (m2-forward-to-code eq-point)
  1847.         (and
  1848.          (looking-at m2-poss-qual-ident-re)
  1849.          (progn
  1850.            (re-search-forward m2-poss-qual-ident-re eq-point t)
  1851.            (goto-char (match-end 0))
  1852.            (m2-forward-to-code eq-point)
  1853.            t)))
  1854.            (t t))
  1855.           ;; Now check for RAISES clause.
  1856. ;;;          (message "m2-API(5)") (sit-for 2)
  1857.           (cond
  1858.            ((looking-at "RAISES")
  1859.         (forward-word 1)
  1860.         (m2-forward-to-code eq-point)
  1861.         (cond
  1862.          ((looking-at "ANY")
  1863.           (forward-word 1)
  1864.           (m2-forward-to-code eq-point)
  1865.           t)
  1866.          ((looking-at "{")
  1867. ;;;          (message "m2-API(5.5)") (sit-for 2)
  1868.           (and
  1869.            (condition-case err
  1870.                (progn (forward-sexp 1) t)
  1871.              (error nil))
  1872.            (progn (m2-forward-to-code eq-point) t)))
  1873.          (t t)))
  1874.            (t t))
  1875.  
  1876.           ;; Now, we better be back to the original =!
  1877.           (= (point) eq-point))))))))))
  1878.  
  1879.  
  1880. (defconst m2-end-matchers
  1881.   (concat
  1882.    "\\bRECORD\\b\\|\\bOBJECT\\b\\|\\bBEGIN\\b\\|\\bTRY\\b\\|\\bLOOP\\b\\|"
  1883.    "\\bIF\\b\\|\\bWHILE\\b\\|\\bWITH\\b\\|\\bFOR\\b\\|\\bCASE\\b\\|"
  1884.    "\\bTYPECASE\\b\\|\\bLOCK\\b\\|\\bINTERFACE\\b\\|\\bMODULE\\b\\|"
  1885.    "\\bGENERIC\\b"))
  1886.  
  1887.  
  1888. (defconst m2-same-line-ssl-keywords
  1889.   "\\bVAR\\b\\|\\bTYPE\\b\\|\\bCONST\\b\\|\\bEXCEPTION\\b\\|\\bREVEAL\\b"
  1890.   "These are the keywords that can be followed by an SSL that begins on
  1891. the same line -- if so, indent to the level of the first elem.")
  1892.  
  1893. (defconst m2-case-starters
  1894.   "TRY\\|CASE\\|TYPECASE")
  1895.  
  1896.  
  1897.  
  1898. (defun m2-backward-to-end-match (part-start &optional depth)
  1899.   (if (not depth) (setq depth 0))
  1900.   (let (res (continue t))
  1901.     (while continue
  1902. ;;;      (message "m2-backward-to-end-match(1) [%d]" depth) (sit-for 1)
  1903.       (setq res (m2-re-search-backward
  1904.          (concat "\\(" m2-end-matchers "\\|END\\)") part-start t))
  1905.       (cond
  1906.        ((and res (looking-at "END"))
  1907.     (m2-backward-to-end-match part-start (1+ depth)))
  1908.        (t
  1909.     (setq continue nil))))
  1910.     res))
  1911.  
  1912. (defun m2-forward-to-end-matcher (max-point)
  1913.   (let (res (continue t))
  1914.     (while continue
  1915.       (setq res (m2-re-search-forward
  1916.          (concat "\\(" m2-statement-starters "\\|END\\)") max-point t))
  1917.       (cond
  1918.        ((looking-at m2-statement-starters)
  1919.     (re-search-forward m2-statement-starters max-point t)
  1920.     (goto-char (match-end 0))
  1921.     (m2-forward-to-end-matcher max-point))
  1922.        (t   ;; looking at END or reached max-point
  1923.     (setq continue nil))))
  1924.     res))
  1925.  
  1926.  
  1927. (defun m2-backward-to-non-comment-line-start (part-start)
  1928.   "Sets the point at the first non-whitespace character in a line that
  1929. contains something other than comments and/or whitespace."
  1930.   (m2-backward-to-code part-start)
  1931.   (beginning-of-line)
  1932.   (m2-skip-whitespace-in-line))
  1933.  
  1934.  
  1935. (defun m2-skip-whitespace-in-line ()
  1936.   (re-search-forward "[ \t]*"))
  1937.  
  1938.  
  1939. (defun m2-indent-to (cur-point new-column)
  1940.   "Make current line indentation NEW-COLUMN.  If the point is to the
  1941. left of the first non-blank character, move it to NEW-COLUMN.
  1942. Otherwise, maintain its relative position.  Has the side effect
  1943. of converting tabs to spaces."
  1944.   (goto-char cur-point)
  1945.   (untabify (save-excursion (beginning-of-line) (point))
  1946.         (save-excursion (end-of-line) (point)))
  1947.   (let ((cur-column (current-column))
  1948.     (cur-point (point))
  1949.     (first-column
  1950.      (save-excursion
  1951.        (beginning-of-line)
  1952.        (re-search-forward " *")
  1953.        (current-column))))
  1954.     (let ((diff (- new-column first-column)))
  1955.       (cond
  1956.        ((> diff 0)
  1957.     (beginning-of-line)
  1958.     ;; Must do this to make sure the keyword completion marker moves
  1959.     ;; correctly.
  1960.     (let ((d diff))
  1961.       (while (> d 0)
  1962.         (insert-before-markers " ") (setq d (1- d))))
  1963.     )
  1964.        ((< diff 0)
  1965.     (save-excursion
  1966.       (forward-char (- first-column cur-column))
  1967.       (backward-delete-char-untabify (- diff)))))
  1968.       (cond
  1969.        ((> first-column cur-column)
  1970.     (beginning-of-line)
  1971.     (forward-char new-column))
  1972.        (t
  1973.     (goto-char (+ cur-point diff)))))))
  1974.  
  1975.  
  1976. (defun m2-in-comment-or-string ()
  1977.   "Returns 'string if point is in an unterminated string, 'comment if in
  1978. an unterminated comment, otherwise, nil."
  1979.   (save-excursion
  1980.     (beginning-of-line)
  1981.     (let ((cur-point (point))
  1982.       (state nil))
  1983.       (save-excursion
  1984.     ;; We assume the lisp-like convention that "top-level defuns,"
  1985.     ;; or "parts", are the only things that occur on the left
  1986.     ;; margin (we make an exception for end-comments.)
  1987.     (m2-backward-to-last-part-begin)
  1988.     (while (and (not state)
  1989.             (re-search-forward
  1990.              (concat "\\(" m2-com-start-re "\\|\"\\)")
  1991.              cur-point t))
  1992.       (goto-char (match-beginning 0))
  1993.       (cond
  1994.        ((looking-at m2-com-start-re)
  1995.         (setq state 'comment)
  1996.         (if (m2-skip-comment-forward cur-point t) (setq state nil)))
  1997.        ((looking-at "\"\\|'")
  1998.         (setq state 'string)
  1999.         (if (re-search-forward "[^\\\\]\\(\"\\|'\\)" cur-point t)
  2000.         (setq state nil)))))
  2001.     state))))
  2002.  
  2003. (defun m2-backward-to-last-part-begin ()
  2004.   (beginning-of-line nil)
  2005.   (if (re-search-backward
  2006.        (concat "^\\(" m2-com-start-re "\\|" m2-part-starters "\\)")
  2007.        (point-min) t)
  2008.       (progn
  2009.     (goto-char (match-beginning 0)))
  2010.     (goto-char (point-min))))
  2011.  
  2012. (defun m2-forward-to-code (max-point)
  2013.   "Sets the point at the first non-comment, non-whitespace character
  2014. following the current point, else at max-point."
  2015. ;;;  (message "m2-forward-to-code (1)") (sit-for 2)
  2016.   (let ((continue t))
  2017.     (while continue
  2018. ;;;      (message "m2-forward-to-code (1.5)") (sit-for 2)
  2019.       (setq continue
  2020.         (and (re-search-forward "[^ \t\n]" max-point 'move-to-limit)
  2021.          (progn (goto-char (match-beginning 0))
  2022. ;;;            (message "m2-forward-to-code (2)") (sit-for 2)
  2023.             (and (looking-at m2-com-start-re)
  2024.                  (m2-skip-comment-forward max-point t))))))))
  2025.  
  2026.  
  2027. (defun m2-backward-to-code (min-point)
  2028.   "Sets the point at the first non-comment, non-whitespace character
  2029. before the current point, else at end-of-file"
  2030.   (interactive "n")
  2031.   (let ((continue t))
  2032.     (while continue
  2033.       (if (re-search-backward "[^ \t\n][ \t\n]*" min-point t)
  2034.       (goto-char (match-beginning 0)))
  2035.       (setq continue (and (save-excursion
  2036.                 (and (> (point) 1)
  2037.                  (progn
  2038.                    (forward-char -1)
  2039.                    (looking-at m2-com-end-re))))
  2040.               (progn
  2041.                 (forward-char 1)
  2042.                 (m2-skip-comment-backward min-point t)))))
  2043.  
  2044.     t))
  2045.  
  2046. (defun m2-re-search-forward (re max-point fail)
  2047.   "Assumes we're not in a comment.  Puts point at the start of the
  2048. first occurence of RE that is not in a comment, if such an occurence
  2049. occurs before MAX-POINT, and returns non-nil.  Otherwise, returns nil
  2050. and leaves point unaffected.  Results are undefined if RE matches any
  2051. comment starter."
  2052.   (let ((continue t)
  2053.     (save-point (point))
  2054.     (res nil))
  2055.     (while continue
  2056.       (setq res (re-search-forward
  2057.           (concat "\\(" m2-com-start-re "\\|" re "\\)")
  2058.           max-point fail))
  2059.       (goto-char (match-beginning 0))
  2060.       (cond
  2061.        (res
  2062.     (cond
  2063.      ((looking-at m2-com-start-re)
  2064.       (m2-skip-comment-forward max-point fail))
  2065.      (t
  2066.       (setq continue nil))))
  2067.        (t
  2068.     (setq continue nil)
  2069.     (if (and (eq fail t) (not res))
  2070.         (goto-char save-point)))))
  2071.     res))
  2072.     
  2073.  
  2074. (defun m2-re-search-backward (re min-point fail)
  2075.   "Assumes we're not in a comment.  Puts point the start of the
  2076. first previous occurence of RE that is not in a comment, if such an occurence
  2077. occurs before MIN-POINT, and returns non-nil.  FAIL is interpreted as is third
  2078. argument to re-search.  Results are undefined if RE matches any comment
  2079. starter." 
  2080.   (let ((continue t)
  2081.     (save-point (point))
  2082.     (res nil))
  2083.     (while continue
  2084.       (setq res (re-search-backward
  2085.          (concat "\\(" m2-com-end-re "\\|" re "\\)") min-point fail))
  2086.       (cond
  2087.        (res
  2088.     (cond
  2089.      ((looking-at m2-com-end-re)
  2090.       (forward-char 2)
  2091.       (m2-skip-comment-backward min-point fail))
  2092.      (t
  2093.       (setq continue nil))))
  2094.        (t
  2095.     (setq continue nil)
  2096.     (if (and (eq fail t) (not res))
  2097.         (goto-char save-point)))))
  2098.     res))
  2099.  
  2100. (defun m2-skip-comment-forward (max-point fail)
  2101.   "Requires that point is at the start of a comment.  If that comment
  2102. is terminated before MAX-POINT, return t and leaves point after end of
  2103. the comment.  Otherwise, if fail is 't, returns returns nil and leaves
  2104. the point unchanged; if fail is nil raises an errer; if fail is not t or nil,
  2105. returns nil and leaves the point at max-point or (point-max), whichever is
  2106. smaller."
  2107.   (if (not (looking-at m2-com-start-re))
  2108.       (error
  2109.        "m2-skip-comment-forward should only be called when looking at
  2110. comment-starter"))
  2111.   (forward-char 2)
  2112.   (let ((save-point (point)) (continue t) res)
  2113.     (while continue
  2114. ;;;      (message "m2-comment-forward (0.5)") (sit-for 2)
  2115.       (setq res (re-search-forward m2-com-start-or-end-re max-point fail))
  2116.       (cond
  2117.        (res
  2118. ;;;    (message "m2-comment-forward (1)") (sit-for 2)
  2119.     (goto-char (match-beginning 0))
  2120. ;;;    (message "m2-comment-forward (2)") (sit-for 2)
  2121.     (cond
  2122.      ((looking-at m2-com-start-re)
  2123.       (if (not (m2-skip-comment-forward max-point fail))
  2124.           (progn (setq res nil)
  2125.              (setq continue nil))))
  2126.      ((looking-at m2-com-end-re)
  2127.       (goto-char (match-end 0))
  2128.       (setq continue nil))
  2129.      (t
  2130. ;;;      (message "m2-comment-forward (4)") (sit-for 2)
  2131.       (goto-char save-point)
  2132.       (setq res nil)
  2133.       (setq continue nil))))
  2134.        (t 
  2135. ;;;    (message "m2-comment-forward (5)") (sit-for 2)
  2136.     (goto-char save-point)
  2137.     (setq res nil)
  2138.     (setq continue nil))))
  2139.     res))
  2140.  
  2141.  
  2142. (defun m2-skip-comment-backward (min-point fail)
  2143.   "Requires that point is at the end of a comment.  If that comment
  2144. is terminated before MIN-POINT, return t and leaves point at the start
  2145. the comment.  Otherwise returns nil and leaves the point in an
  2146. unspecified position."
  2147.   (forward-char -2)
  2148.   (if (not (looking-at m2-com-end-re))
  2149.       (error
  2150.        "m2-skip-comment-backward should only be called when looking at
  2151. comment-ender"))
  2152.   (let ((save-point (point)) (continue t) res)
  2153.     (while continue
  2154.       (setq res (re-search-backward m2-com-start-or-end-re min-point fail))
  2155.       (cond
  2156.        (res
  2157.     (cond
  2158.      ((looking-at m2-com-end-re)
  2159.       (forward-char 2)
  2160.       (if (not (m2-skip-comment-backward min-point fail))
  2161.           (progn
  2162.         (setq res nil)
  2163.         (setq continue nil))))
  2164.      ((looking-at m2-com-start-re)
  2165.       (setq continue nil))
  2166.      (t
  2167.       (goto-char save-point)
  2168.       (setq res nil)
  2169.       (setq continue nil))))
  2170.        (t
  2171.     (goto-char save-point)
  2172.     (setq res nil)
  2173.     (setq continue nil))))
  2174.     res))
  2175.      
  2176. ;;;======================================================================
  2177. ;;; Electric END completion
  2178.  
  2179. (defun m2-do-electric-end ()
  2180. ;;;  (message "m2-do-electric-end") (sit-for 2)
  2181.   (let ((case-fold-search nil))
  2182.     (cond
  2183.      ((and (save-excursion
  2184.          (beginning-of-line)
  2185.          (looking-at "^[ \t]*END[ \t]*$"))
  2186.        (or m2-electric-end m2-blink-end-matchers))
  2187.       (let ((insert-point
  2188.          (save-excursion (beginning-of-line) (forward-word 1) (point)))
  2189.         (insert-string))
  2190. ;;;    (progn (message "m2-do-electric-end 2") (sit-for 2) t)
  2191.     (save-excursion
  2192.       (beginning-of-line)
  2193.       (and
  2194.        (m2-backward-to-end-match (point-min))
  2195.        (if m2-blink-end-matchers (sit-for 1) t)
  2196. ;;;       (progn (message "m2-do-electric-end 3") (sit-for 1) t)
  2197.        (progn
  2198.          (cond
  2199.           ;; Do nothing if we're not supposed to...
  2200.           ((not m2-electric-end))
  2201.           ;; If it's a begin, what is it the begin of?
  2202.           ((looking-at "BEGIN")
  2203.            (cond
  2204.         ;; If it's on the left margin, it must be a module.
  2205.         ((looking-at "^BEGIN")
  2206.          (goto-char (point-min))
  2207.          (and
  2208.           (re-search-forward "MODULE\\|INTERFACE" (point-max) t)
  2209.           (progn
  2210.             (goto-char (match-end 0))
  2211.             (forward-word 1)
  2212.             (setq insert-string
  2213.               (concat
  2214.                (buffer-substring
  2215.                 (save-excursion (forward-word -1) (point))
  2216.                 (point))
  2217.                ".")))))
  2218.         ;; Is it the body of a procedure?
  2219.         ((and
  2220. ;;;        (progn (message "m2-do-electric-end PROC 1") (sit-for 2) t)
  2221.           (m2-re-search-backward "BEGIN\\|PROCEDURE" (point-min) t)
  2222.           (looking-at "PROCEDURE"))
  2223. ;;;           (progn (message "m2-do-electric-end PROC 2") (sit-for 2) t)
  2224.          (forward-word 2)
  2225.          (setq insert-string
  2226.                (concat
  2227.             (buffer-substring
  2228.              (save-excursion (forward-word -1) (point))
  2229.              (point))
  2230.             ";")))
  2231.         ;; Otherwise, it is just a random BEGIN, so
  2232.         ;; m2-electric-end must be 'all.
  2233.         ((eq m2-electric-end 'all)
  2234.          (setq insert-string "(* BEGIN *)"))))
  2235.  
  2236.           ((looking-at "INTERFACE\\|MODULE")
  2237.            (forward-word 2)
  2238.            (setq insert-string
  2239.              (concat
  2240.               (buffer-substring
  2241.                (save-excursion (forward-word -1) (point))
  2242.                (point))
  2243.               ".")))
  2244.  
  2245.           ;; Otherwise, m2-electric-end must be 'all.
  2246.           ((eq m2-electric-end 'all)
  2247. ;;;           (progn (message "m2-do-electric-end non-BEGIN") (sit-for 2) t)
  2248.            (setq insert-string
  2249.              (concat "(* "
  2250.                  (buffer-substring
  2251.                   (point)
  2252.                   (save-excursion (forward-word 1) (point)))
  2253.                  " *)")))))))
  2254.  
  2255.     (and
  2256.      insert-string
  2257.      (progn
  2258.        (goto-char insert-point)
  2259.        ;; If we completed an END and then added something, include
  2260.        ;; the something in the completion...
  2261.        (if (and (marker-position m2-cur-keyword-completion-start)
  2262.             (= insert-point
  2263.                (+ m2-cur-keyword-completion-start
  2264.               m2-cur-keyword-completion-len)))
  2265.            (setq m2-cur-keyword-completion-len
  2266.              (+ m2-cur-keyword-completion-len 1
  2267.             (length insert-string))))
  2268.        (insert " " insert-string))))))))
  2269.  
  2270.         
  2271.  
  2272. ;;; modula2.el ends here
  2273.