lisp/progmodes/modula2.el

   1 ;;; modula2.el --- Modula-2 editing support package
   2
   3 ;; Author: Michael Schmidt <michael@pbinfo.UUCP>
   4 ;;      Tom Perrine <Perrin@LOGICON.ARPA>
   5 ;; Keywords: languages
   6
   7 ;; The authors distributed this without a copyright notice
   8 ;; back in 1988, so it is in the public domain.  The original included
   9 ;; the following credit:
  10
  11 ;; Author Mick Jordan
  12 ;; amended Peter Robinson
  13
  14 ;;; Commentary:
  15
  16 ;; A major mode for editing Modula-2 code.  It provides convenient abbrevs
  17 ;; for Modula-2 keywords, knows about the standard layout rules, and supports
  18 ;; a native compile command.
  19
  20 ;;; Code:
  21
  22 ;;; Added by Tom Perrine (TEP)
  23 (defvar m2-mode-syntax-table nil
  24   "Syntax table in use in Modula-2 buffers.")
  25
  26 (defvar m2-compile-command "m2c"
  27   "Command to compile Modula-2 programs")
  28
  29 (defvar m2-link-command "m2l"
  30   "Command to link Modula-2 programs")
  31
  32 (defvar m2-link-name nil
  33   "Name of the executable.")
  34
  35
  36 (if m2-mode-syntax-table
  37     ()
  38   (let ((table (make-syntax-table)))
  39     (modify-syntax-entry ?\\ "\\" table)
  40     (modify-syntax-entry ?\( ". 1" table)
  41     (modify-syntax-entry ?\) ". 4" table)
  42     (modify-syntax-entry ?* ". 23" table)
  43     (modify-syntax-entry ?+ "." table)
  44     (modify-syntax-entry ?- "." table)
  45     (modify-syntax-entry ?= "." table)
  46     (modify-syntax-entry ?% "." table)
  47     (modify-syntax-entry ?< "." table)
  48     (modify-syntax-entry ?> "." table)
  49     (modify-syntax-entry ?\' "\"" table)
  50     (setq m2-mode-syntax-table table)))
  51
  52 ;;; Added by TEP
  53 (defvar m2-mode-map nil
  54   "Keymap used in Modula-2 mode.")
  55
  56 (if m2-mode-map ()
  57   (let ((map (make-sparse-keymap)))
  58     (define-key map "\^i" 'm2-tab)
  59     (define-key map "\C-cb" 'm2-begin)
  60     (define-key map "\C-cc" 'm2-case)
  61     (define-key map "\C-cd" 'm2-definition)
  62     (define-key map "\C-ce" 'm2-else)
  63     (define-key map "\C-cf" 'm2-for)
  64     (define-key map "\C-ch" 'm2-header)
  65     (define-key map "\C-ci" 'm2-if)
  66     (define-key map "\C-cm" 'm2-module)
  67     (define-key map "\C-cl" 'm2-loop)
  68     (define-key map "\C-co" 'm2-or)
  69     (define-key map "\C-cp" 'm2-procedure)
  70     (define-key map "\C-c\C-w" 'm2-with)
  71     (define-key map "\C-cr" 'm2-record)
  72     (define-key map "\C-cs" 'm2-stdio)
  73     (define-key map "\C-ct" 'm2-type)
  74     (define-key map "\C-cu" 'm2-until)
  75     (define-key map "\C-cv" 'm2-var)
  76     (define-key map "\C-cw" 'm2-while)
  77     (define-key map "\C-cx" 'm2-export)
  78     (define-key map "\C-cy" 'm2-import)
  79     (define-key map "\C-c{" 'm2-begin-comment)
  80     (define-key map "\C-c}" 'm2-end-comment)
  81     (define-key map "\C-j"  'm2-newline)
  82     (define-key map "\C-c\C-z" 'suspend-emacs)
  83     (define-key map "\C-c\C-v" 'm2-visit)
  84     (define-key map "\C-c\C-t" 'm2-toggle)
  85     (define-key map "\C-c\C-l" 'm2-link)
  86     (define-key map "\C-c\C-c" 'm2-compile)
  87     (setq m2-mode-map map)))
  88
  89 (defvar m2-indent 5 "*This variable gives the indentation in Modula-2-Mode")
  90
  91 ;;;###autoload
  92 (defun modula-2-mode ()
  93   "This is a mode intended to support program development in Modula-2.
  94 All control constructs of Modula-2 can be reached by typing C-c
  95 followed by the first character of the construct.
  96 \\<m2-mode-map>
  97   \\[m2-begin] begin         \\[m2-case] case
  98   \\[m2-definition] definition    \\[m2-else] else
  99   \\[m2-for] for           \\[m2-header] header
 100   \\[m2-if] if            \\[m2-module] module
 101   \\[m2-loop] loop          \\[m2-or] or
 102   \\[m2-procedure] procedure     Control-c Control-w with
 103   \\[m2-record] record        \\[m2-stdio] stdio
 104   \\[m2-type] type          \\[m2-until] until
 105   \\[m2-var] var           \\[m2-while] while
 106   \\[m2-export] export        \\[m2-import] import
 107   \\[m2-begin-comment] begin-comment \\[m2-end-comment] end-comment
 108   \\[suspend-emacs] suspend Emacs     \\[m2-toggle] toggle
 109   \\[m2-compile] compile           \\[m2-next-error] next-error
 110   \\[m2-link] link
 111
 112    `m2-indent' controls the number of spaces for each indentation.
 113    `m2-compile-command' holds the command to compile a Modula-2 program.
 114    `m2-link-command' holds the command to link a Modula-2 program."
 115   (interactive)
 116   (kill-all-local-variables)
 117   (use-local-map m2-mode-map)
 118   (setq major-mode 'modula-2-mode)
 119   (setq mode-name "Modula-2")
 120   (make-local-variable 'comment-column)
 121   (setq comment-column 41)
 122   (make-local-variable 'end-comment-column)
 123   (setq end-comment-column 75)
 124   (set-syntax-table m2-mode-syntax-table)
 125   (make-local-variable 'paragraph-start)
 126   (setq paragraph-start (concat "^$\\|" page-delimiter))
 127   (make-local-variable 'paragraph-separate)
 128   (setq paragraph-separate paragraph-start)
 129   (make-local-variable 'paragraph-ignore-fill-prefix)
 130   (setq paragraph-ignore-fill-prefix t)
 131 ;  (make-local-variable 'indent-line-function)
 132 ;  (setq indent-line-function 'c-indent-line)
 133   (make-local-variable 'require-final-newline)
 134   (setq require-final-newline t)
 135   (make-local-variable 'comment-start)
 136   (setq comment-start "(* ")
 137   (make-local-variable 'comment-end)
 138   (setq comment-end " *)")
 139   (make-local-variable 'comment-column)
 140   (setq comment-column 41)
 141   (make-local-variable 'comment-start-skip)
 142   (setq comment-start-skip "/\\*+ *")
 143   (make-local-variable 'comment-indent-function)
 144   (setq comment-indent-function 'c-comment-indent)
 145   (make-local-variable 'parse-sexp-ignore-comments)
 146   (setq parse-sexp-ignore-comments t)
 147   (run-hooks 'm2-mode-hook))
 148
 149 (defun m2-newline ()
 150   "Insert a newline and indent following line like previous line."
 151   (interactive)
 152   (let ((hpos (current-indentation)))
 153     (newline)
 154     (indent-to hpos)))
 155
 156 (defun m2-tab ()
 157   "Indent to next tab stop."
 158   (interactive)
 159   (indent-to (* (1+ (/ (current-indentation) m2-indent)) m2-indent)))
 160
 161 (defun m2-begin ()
 162   "Insert a BEGIN keyword and indent for the next line."
 163   (interactive)
 164   (insert "BEGIN")
 165   (m2-newline)
 166   (m2-tab))
 167
 168 (defun m2-case ()
 169   "Build skeleton CASE statment, prompting for the <expression>."
 170   (interactive)
 171   (let ((name (read-string "Case-Expression: ")))
 172     (insert "CASE " name " OF")
 173     (m2-newline)
 174     (m2-newline)
 175     (insert "END (* case " name " *);"))
 176   (end-of-line 0)
 177   (m2-tab))
 178
 179 (defun m2-definition ()
 180   "Build skeleton DEFINITION MODULE, prompting for the <module name>."
 181   (interactive)
 182   (insert "DEFINITION MODULE ")
 183   (let ((name (read-string "Name: ")))
 184     (insert name ";\n\n\n\nEND " name ".\n"))
 185   (previous-line 3))
 186
 187 (defun m2-else ()
 188   "Insert ELSE keyword and indent for next line."
 189   (interactive)
 190   (m2-newline)
 191   (backward-delete-char-untabify m2-indent ())
 192   (insert "ELSE")
 193   (m2-newline)
 194   (m2-tab))
 195
 196 (defun m2-for ()
 197   "Build skeleton FOR loop statment, prompting for the loop parameters."
 198   (interactive)
 199   (insert "FOR ")
 200   (let ((name (read-string "Loop Initialiser: ")) limit by)
 201     (insert name " TO ")
 202     (setq limit (read-string "Limit: "))
 203     (insert limit)
 204     (setq by (read-string "Step: "))
 205     (if (not (string-equal by ""))
 206         (insert " BY " by))
 207     (insert " DO")
 208     (m2-newline)
 209     (m2-newline)
 210     (insert "END (* for " name " to " limit " *);"))
 211   (end-of-line 0)
 212   (m2-tab))
 213
 214 (defun m2-header ()
 215   "Insert a comment block containing the module title, author, etc."
 216   (interactive)
 217   (insert "(*\n    Title: \t")
 218   (insert (read-string "Title: "))
 219   (insert "\n    Created:\t")
 220   (insert (current-time-string))
 221   (insert "\n    Author: \t")
 222   (insert (user-full-name))
 223   (insert (concat "\n\t\t<" (user-login-name) "@" (system-name) ">\n"))
 224   (insert "*)\n\n"))
 225
 226 (defun m2-if ()
 227   "Insert skeleton IF statment, prompting for <boolean-expression>."
 228   (interactive)
 229   (insert "IF ")
 230   (let ((thecondition (read-string "<boolean-expression>: ")))
 231     (insert thecondition " THEN")
 232     (m2-newline)
 233     (m2-newline)
 234     (insert "END (* if " thecondition " *);"))
 235   (end-of-line 0)
 236   (m2-tab))
 237
 238 (defun m2-loop ()
 239   "Build skeleton LOOP (with END)."
 240   (interactive)
 241   (insert "LOOP")
 242   (m2-newline)
 243   (m2-newline)
 244   (insert "END (* loop *);")
 245   (end-of-line 0)
 246   (m2-tab))
 247
 248 (defun m2-module ()
 249   "Build skeleton IMPLEMENTATION MODULE, prompting for <module-name>."
 250   (interactive)
 251   (insert "IMPLEMENTATION MODULE ")
 252   (let ((name (read-string "Name: ")))
 253     (insert name ";\n\n\n\nEND " name ".\n")
 254     (previous-line 3)
 255     (m2-header)
 256     (m2-type)
 257     (newline)
 258     (m2-var)
 259     (newline)
 260     (m2-begin)
 261     (m2-begin-comment)
 262     (insert " Module " name " Initialisation Code "))
 263   (m2-end-comment)
 264   (newline)
 265   (m2-tab))
 266
 267 (defun m2-or ()
 268   (interactive)
 269   (m2-newline)
 270   (backward-delete-char-untabify m2-indent)
 271   (insert "|")
 272   (m2-newline)
 273   (m2-tab))
 274
 275 (defun m2-procedure ()
 276   (interactive)
 277   (insert "PROCEDURE ")
 278   (let ((name (read-string "Name: " ))
 279         args)
 280     (insert name " (")
 281     (insert (read-string "Arguments: ") ")")
 282     (setq args (read-string "Result Type: "))
 283     (if (not (string-equal args ""))
 284         (insert " : " args))
 285     (insert ";")
 286     (m2-newline)
 287     (insert "BEGIN")
 288     (m2-newline)
 289     (m2-newline)
 290     (insert "END ")
 291     (insert name)
 292     (insert ";")
 293     (end-of-line 0)
 294     (m2-tab)))
 295
 296 (defun m2-with ()
 297   (interactive)
 298   (insert "WITH ")
 299   (let ((name (read-string "Record-Type: ")))
 300     (insert name)
 301     (insert " DO")
 302     (m2-newline)
 303     (m2-newline)
 304     (insert "END (* with " name " *);"))
 305   (end-of-line 0)
 306   (m2-tab))
 307
 308 (defun m2-record ()
 309   (interactive)
 310   (insert "RECORD")
 311   (m2-newline)
 312   (m2-newline)
 313   (insert "END (* record *);")
 314   (end-of-line 0)
 315   (m2-tab))
 316
 317 (defun m2-stdio ()
 318   (interactive)
 319   (insert "
 320 FROM TextIO IMPORT
 321    WriteCHAR, ReadCHAR, WriteINTEGER, ReadINTEGER,
 322    WriteCARDINAL, ReadCARDINAL, WriteBOOLEAN, ReadBOOLEAN,
 323    WriteREAL, ReadREAL, WriteBITSET, ReadBITSET,
 324    WriteBasedCARDINAL, ReadBasedCARDINAL, WriteChars, ReadChars,
 325    WriteString, ReadString, WhiteSpace, EndOfLine;
 326
 327 FROM SysStreams IMPORT sysIn, sysOut, sysErr;
 328
 329 "))
 330
 331 (defun m2-type ()
 332   (interactive)
 333   (insert "TYPE")
 334   (m2-newline)
 335   (m2-tab))
 336
 337 (defun m2-until ()
 338   (interactive)
 339   (insert "REPEAT")
 340   (m2-newline)
 341   (m2-newline)
 342   (insert "UNTIL ")
 343   (insert (read-string "<boolean-expression>: ") ";")
 344   (end-of-line 0)
 345   (m2-tab))
 346
 347 (defun m2-var ()
 348   (interactive)
 349   (m2-newline)
 350   (insert "VAR")
 351   (m2-newline)
 352   (m2-tab))
 353
 354 (defun m2-while ()
 355   (interactive)
 356   (insert "WHILE ")
 357   (let ((name (read-string "<boolean-expression>: ")))
 358     (insert name " DO" )
 359     (m2-newline)
 360     (m2-newline)
 361     (insert "END (* while " name " *);"))
 362   (end-of-line 0)
 363   (m2-tab))
 364
 365 (defun m2-export ()
 366   (interactive)
 367   (insert "EXPORT QUALIFIED "))
 368
 369 (defun m2-import ()
 370   (interactive)
 371   (insert "FROM ")
 372   (insert (read-string "Module: "))
 373   (insert " IMPORT "))
 374
 375 (defun m2-begin-comment ()
 376   (interactive)
 377   (if (not (bolp))
 378       (indent-to comment-column 0))
 379   (insert "(*  "))
 380
 381 (defun m2-end-comment ()
 382   (interactive)
 383   (if (not (bolp))
 384       (indent-to end-comment-column))
 385   (insert "*)"))
 386
 387 (defun m2-compile ()
 388   (interactive)
 389   (setq modulename (buffer-name))
 390   (compile (concat m2-compile-command " " modulename)))
 391
 392 (defun m2-link ()
 393   (interactive)
 394   (setq modulename (buffer-name))
 395   (if m2-link-name
 396       (compile (concat m2-link-command " " m2-link-name))
 397     (compile (concat m2-link-command " "
 398                      (setq m2-link-name (read-string "Name of executable: "
 399                                                      modulename))))))
 400
 401 (defun execute-monitor-command (command)
 402   (let* ((shell shell-file-name)
 403          (csh (equal (file-name-nondirectory shell) "csh")))
 404     (call-process shell nil t t "-cf" (concat "exec " command))))
 405
 406 (defun m2-visit ()
 407   (interactive)
 408   (let ((deffile nil)
 409         (modfile nil)
 410         modulename)
 411     (save-excursion
 412       (setq modulename
 413             (read-string "Module name: "))
 414       (switch-to-buffer "*Command Execution*")
 415       (execute-monitor-command (concat "m2whereis " modulename))
 416       (goto-char (point-min))
 417       (condition-case ()
 418           (progn (re-search-forward "\\(.*\\.def\\) *$")
 419                  (setq deffile (buffer-substring (match-beginning 1)
 420                                                  (match-end 1))))
 421         (search-failed ()))
 422       (condition-case ()
 423           (progn (re-search-forward "\\(.*\\.mod\\) *$")
 424                  (setq modfile (buffer-substring (match-beginning 1)
 425                                                  (match-end 1))))
 426         (search-failed ()))
 427       (if (not (or deffile modfile))
 428           (error "I can find neither definition nor implementation of %s"
 429                  modulename)))
 430     (cond (deffile
 431             (find-file deffile)
 432             (if modfile
 433                 (save-excursion
 434                   (find-file modfile))))
 435           (modfile
 436            (find-file modfile)))))
 437
 438 (defun m2-toggle ()
 439   "Toggle between .mod and .def files for the module."
 440   (interactive)
 441   (cond ((string-equal (substring (buffer-name) -4) ".def")
 442          (find-file-other-window
 443           (concat (substring (buffer-name) 0 -4) ".mod")))
 444         ((string-equal (substring (buffer-name) -4) ".mod")
 445          (find-file-other-window
 446           (concat (substring (buffer-name) 0 -4)  ".def")))
 447         ((string-equal (substring (buffer-name) -3) ".mi")
 448          (find-file-other-window
 449           (concat (substring (buffer-name) 0 -3)  ".md")))
 450         ((string-equal (substring (buffer-name) -3) ".md")
 451          (find-file-other-window
 452           (concat (substring (buffer-name) 0 -3)  ".mi")))))
 453
 454 ;;; modula2.el ends here