Annotation of 43BSDReno/contrib/emacs-18.55/lisp/modula2.el, revision 1.1

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")))))

unix.superglobalmegacorp.com

This archive runs on limited infrastructure. Preserving old code on modern bandwidth. Automated agents are requested to crawl responsibly.