;;; major mode for programming in MOO-code
;;; by Erik Ostrom (eostrom@nic.gac.edu)
;;; 1992
;;;
;;; for use with mud.el and assorted derivations thereof
;;; to use: load-file this file (or eval-current-buffer)
;;; M-x moo-code-mode
;;; Make sure your client is loaded _before_ this file, if you want to
;;; use it interactively (i.e., edit verbs online).
;;; This has been tested with the mud.el available on parcftp.xerox.com
;;; as of Thu Dec 3 16:40:33 1992. I have no idea if it will work with
;;; others. I suggest you put this file somewhere in your load-path,
;;; modify your copy of mud.el to
;;; (require 'moo-code)
;;; *at the end of the file*,
;;; and add the line
;;; (moo-code-mode)
;;; at the very beginning of the function definition for moo-fix-listing.
;;; It would also be nice to have moo-code-mode interact nicely with
;;; MOO's "local editing" facility, but that's more complicated.
(provide 'moo-code)
(defconst moo-code-reserved-words
'(("if[ (]" "for[ (]" "while[ (]" "fork[ (]" "else")
("endif" "endfor" "endwhile" "endfork" "else")))
(define-prefix-command 'moo-code-extras-map)
(let ((map 'moo-code-extras-map))
(define-key map "i" 'moo-code-if)
(define-key map "e" 'moo-code-else)
(define-key map "f" 'moo-code-for)
(define-key map "w" 'moo-code-while)
(define-key map "k" 'moo-code-fork)
(define-key map "r" 'moo-code-return)
(define-key map "s" 'moo-code-sin)
(define-key map "c" 'moo-code-commentify)
(define-key map "u" 'moo-code-uncommentify))
(defvar moo-code-mode-map
(let ((map (copy-keymap (cond ((boundp 'moo-macro-mode-map)
moo-macro-mode-map) ; kluge for diff versions
((boundp 'mud-macro-expansion-mode-map)
mud-macro-expansion-mode-map)
(t
(make-sparse-keymap))))))
(define-key map "\t" 'moo-code-indent-line)
(define-key map "\C-c\C-a" 'moo-code-extras-map)
(define-key map "\C-c\"" 'moo-code-insert-quoted-end)
(define-key map "\C-c\;" 'moo-code-check-semi-colons)
map)
"Extra keys used in MOO-code mode.")
(defmacro mud-perform-replace (from to)
"Replace one string with another."
(list 'save-excursion
(list 'while (list 'search-forward from nil t)
(cond ((not (equal to ""))
(list 'replace-match to t t))
(t
(list 'delete-char
(if (stringp from)
(- (length from))
(list '- (list 'length from)))))))))
(defvar mud-mode-syntax-table nil
"Syntax table used while in MUD mode.")
(defun moo-code-mode ()
"Major mode for mucking with MOO code.
Commands:
\\{moo-code-mode-map}
"
(interactive)
(kill-all-local-variables)
(setq mode-name "MOO-Code")
(setq major-mode 'moo-code-mode)
(if (null mud-mode-syntax-table)
(progn
(setq mud-mode-syntax-table (make-syntax-table))
(set-syntax-table mud-mode-syntax-table)
(modify-syntax-entry ?_ "w")
(modify-syntax-entry ?\[ "(]")
(modify-syntax-entry ?\] ")["))
(set-syntax-table mud-mode-syntax-table))
(use-local-map moo-code-mode-map)
(make-local-variable 'mud-expansion-macro-name)
(make-local-variable 'indent-line-function)
(setq indent-line-function 'moo-code-indent-line)
(message "Use ^C^S to send, ^C^C to send and destroy, ^C^] to abort..."))
(if (boundp 'mud-macro-modes)
(setq mud-macro-modes
(cons 'moo-code-mode
mud-macro-modes)))
(defun moo-code-return (expression)
(interactive "sExpression: ")
(moo-code-indent-line)
(insert "return (" expression ");\n")
(moo-code-indent-line))
(defun moo-code-for (variable set)
(interactive "sVariable: \nsIn set: ")
(if (not (or (eq (elt set 0) ?\()
(eq (elt set (1- (length set))) ?\))
(eq (elt set 0) ?\[)
(eq (elt set (1- (length set))) ?\])))
(setq set (format (if (string-match ".+\\.\\..+" set)
"[%s]"
"(%s)")
set)))
(moo-code-insert-statement "for" (concat " " variable " in " set)))
(defun moo-code-fork (seconds)
(interactive "sSeconds: ")
(moo-code-insert-statement "fork" (concat " (" seconds ")")))
(defun moo-code-while (condition)
(interactive "sCondition: ")
(moo-code-insert-statement "while" (concat " (" condition ")")))
(defun moo-code-if (condition)
(interactive "sCondition: ")
(moo-code-insert-statement "if" (concat " (" condition ")")))
(defun moo-code-insert-statement (statement argument)
(moo-code-indent-line)
(insert statement argument "\n")
(moo-code-indent-line)
(save-excursion
(newline)
(insert "end" statement)
(moo-code-indent-line)
(if (not (looking-at "\n"))
(progn
(newline)
(moo-code-indent-line)))))
(defun moo-code-sin (delay message)
(interactive "nDelay: \nsMessage: ")
(insert "$command_utils:suspend_if_needed(" (int-to-string delay)
(if (eq (length message) 0)
""
(concat ", " (prin1-to-string message)))
");"))
(defun moo-code-else (elseif)
(interactive "P")
(if elseif (call-interactively 'moo-code-elseif)
(progn
(back-to-indentation)
(insert "else")
(moo-code-indent-line)
(newline)
(moo-code-indent-line))))
(defun moo-code-elseif (condition)
(interactive "sCondition: ")
(insert "elseif (" condition ")")
(moo-code-indent-line)
(insert "\n")
(moo-code-indent-line))
(defun moo-code-indent-line ()
(interactive)
(let* ((pos (- (point-max) (point)))
(orig (point-marker))
(gotoindent (progn (back-to-indentation)
(>= (point) orig))))
(if (not (looking-at "^\\.$"))
(indent-to
(let ((offset 0))
(delete-horizontal-space)
(if (memq t (mapcar 'looking-at (nth 1 moo-code-reserved-words)))
(setq offset -2))
(save-excursion
(if (not (eq (forward-line -1) -1))
(progn
(while (and (looking-at "^\\s-*$")
(not (eq (forward-line -1) -1))))
(back-to-indentation)
(if (memq t (mapcar 'looking-at
(car moo-code-reserved-words)))
(setq offset (+ 2 offset)))
(+ (current-indentation) offset))
0)))))
(if gotoindent
(back-to-indentation)
(goto-char orig))))
(defun moo-code-commentify (start end)
(interactive "r")
(save-excursion
(goto-char end)
(end-of-line)
(setq end (point))
(goto-char start)
(beginning-of-line)
(setq start (point))
(save-restriction
(narrow-to-region start end)
(mud-perform-replace "\\" "\\\\")
(mud-perform-replace "\"" "\\\"")
(while (re-search-forward "^.*$" nil t)
(back-to-indentation)
; (beginning-of-line)
(insert "\"")
(end-of-line)
(insert "\";")))))
(defun moo-code-uncommentify (start end)
(interactive "r")
(save-excursion
(goto-char end)
(end-of-line)
(setq end (point))
(goto-char start)
(beginning-of-line)
(setq start (point))
(save-restriction
(narrow-to-region start end)
(while (re-search-forward "^.*$" nil t)
(back-to-indentation)
(delete-char 1)
(end-of-line)
(delete-char -2))
(goto-char start)
(mud-perform-replace "\\\\" "\1")
(mud-perform-replace "\\\"" "\"")
(mud-perform-replace "\1" "\\"))))
(defun moo-code-insert-quoted-end ()
(interactive)
(insert ", \".\");"))
(defun moo-code-check-semi-colons ()
(interactive)
(save-excursion
(goto-char (point-min))
(while (eq (char-after (point)) ?@)
(forward-line 1))
(while (re-search-forward "^.+$" nil t)
(back-to-indentation)
(if (memq t (mapcar 'looking-at
(apply 'append moo-code-reserved-words)))
(if (and (progn
(end-of-line)
(eq (char-after (1- (point))) ?\;))
(sit-for 1)
(y-or-n-p "Inappropriate semicolon. Delete? "))
(delete-char -1))
(if (and (prog1
(not (looking-at "$"))
(end-of-line))
(progn
(not (memq (char-after (1- (point))) '(?\; ?.))))
(sit-for 1)
(y-or-n-p "Missing semicolon. Insert? "))
(insert ";")))))
(message "Done."))