lisp/progmodes/modula2.el

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