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