home *** CD-ROM | disk | FTP | other *** search
/ Geek Gadgets 1 / ADE-1.bin / ade-dist / emacs-18.59-src.tgz / emacs-18.59-src.tar / fsf / emacs18 / lisp / modula2.el < prev    next >
Lisp/Scheme  |  1996-09-28  |  12KB  |  419 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-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")))))
  419.