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