[MLton] Simple emacs mode for editing mlb files.
Stephen Weeks
MLton@mlton.org
Mon, 13 Sep 2004 21:23:57 -0700
> I cut 'n pasted together an emacs mlb-mode to edit mlb files from
> the standard sml-mode.el file.
Thanks Ray.
I've been using (my own variant of) sml-mode for editing mlb files,
which has worked pretty well, since they use the same lexical
structure and almost the same keywords. I think it's nice to use the
same mode for both, which makes the same commands available as well --
I have commands for running MLton, saving sml files, etc. My guess is
a single mode may be an easier way to go.
In case we need it in the future, here's Ray's mlb.el for the
archives.
--------------------------------------------------------------------------------
;;; Simple mode for MLton's MLB files.
;;; Version: 0.1
;;; Date: 9/12/04
;;; Author: Ray Racine with major cut and based from standard SML el files.
;;; See: SML mode el files found in Emacs/XEmacs and SML distros to see those
;;; who did the real coding.
;;; This is my first attempt at doing anything in elisp/emacs. All caveats apply 10x.
;;; Installation:
;;; - byte compile mlb.el
;;; - copy mlb.el and mlb.elc into your emacs load-path
;;; the same location where your SML mode el/elc files should work.
;;; - add the following 2 s-exps to your .emacs
;;; (add-to-list 'auto-mode-alist '("\\.mlb\\'" . mlb-mode))
;;; (autoload (quote mlb-mode) "mlb" "\
;;; Major mode for editing MLB (MLton build files for SML).
;;; Entry to this mode runs the mlb-mode-hook." t nil)
;;; Patches,comments,fixes welcome. rracine ATTHISHOSTISFINE adelphia DOTGOESHERE net
(eval-when-compile (require 'cl))
;;==================================================================
;;; Variables
;;==================================================================
(defcustom mlb-indent-level 4
"*Indentation of blocks."
:group 'mlb
:type '(integer))
(defcustom mlb-mode-info "mlb-mode"
"*TBD")
(defvar mlb-mode-hook nil
"*Run upon entering `mlb-mode'.
This is a good place to put your preferred key bindings.")
;;======
;; DEFS
;;======
;; flatten nested lists
(defun flatten (ls &optional acc)
(if (null ls) acc
(let ((rest (flatten (cdr ls) acc))
(head (car ls)))
(if (listp head)
(flatten head rest)
(cons head rest)))))
;; Build word matching regexps
(defun mlb-syms-re (&rest syms)
(concat "\\<" (regexp-opt (flatten syms) t) "\\>"))
(defconst mlb-start-block-syms
'("local" "in" "bas")
"MLB symbols which indicate the start of a block.")
(defconst mlb-open-syms
`,(append '("structure" "signature" "functor" "basis") mlb-start-block-syms)
"MLB symbols which open")
(defconst mlb-close-syms
'("end" "in")
"MLB symbols which indicate the end of a block.")
(defconst mlb-open-syms-re
(apply 'mlb-syms-re (append mlb-open-syms mlb-close-syms))
"Regexp to match start of a mlb statement.")
(defconst mlb-all-syms
`,(append mlb-open-syms mlb-close-syms))
(defconst mlb-all-syms-re
(apply 'mlb-syms-re mlb-all-syms))
;;==================================================================
;;; Code for MLB-MODE
;;==================================================================
(defface font-lock-module-def-face
'((t (:bold t)))
"Font Lock mode face used to highlight module definitions."
:group 'font-lock-highlighting-faces)
(defvar font-lock-module-def-face 'font-lock-module-def-face
"Face name to use for module definitions.")
(defface font-lock-interface-def-face
'((t (:bold t)))
"Font Lock mode face used to highlight interface definitions."
:group 'font-lock-highlighting-faces)
(defvar font-lock-interface-def-face 'font-lock-interface-def-face
"Face name to use for interface definitions.")
(defconst mlb-keywords-regexp
(mlb-syms-re "basis" "bas" "local" "end" "in")
"Regexps that match mlb keywords.")
(defconst mlb-font-lock-keywords
`(("\\<\\(structure\\|functor\\|basis\\)\\s-+\\(\\sw+\\)"
(1 font-lock-keyword-face)
(2 font-lock-module-def-face))
("\\<\\(signature\\)\\s-+\\(\\sw+\\)"
(1 font-lock-keyword-face)
(2 font-lock-interface-def-face))
(,mlb-keywords-regexp . font-lock-keyword-face))
"Regexps matching mlb and sml keyworks used by mlb files.")
(defconst mlb-extended-chars-for-fontification
'((?_ . "w")(?' . "w"))
"Underscore and quote are fontifiable chars in a word.")
(defconst mlb-font-lock-defaults
`(mlb-font-lock-keywords nil nil ,mlb-extended-chars-for-fontification nil))
;;============================
;; Indentation & Move routines
;;============================
(defun mlb-keyword-forward ()
(interactive)
(when (re-search-forward mlb-all-syms-re nil t)
(mlb-backward-read-sym)))
(defun mlb-keyword-backward ()
(interactive)
(when (re-search-backward mlb-all-syms-re nil t)
(mlb-move-read-sym)))
(defun mlb-stmt-sym-backwards ()
(interactive)
(when (re-search-backward mlb-open-syms-re nil t)
(mlb-move-read-sym)))
(defun mlb-stmt-sym-forwards ()
(interactive)
(when (re-search-forward mlb-open-syms-re nil t)
(mlb-backward-read-sym)))
(defun goto-beginning-of-line-text ()
(beginning-of-line)
(skip-syntax-forward "-"))
(defun indent-1 (dent)
(+ dent mlb-indent-level))
(defun outdent-1 (dent)
(let ((newdent (- dent mlb-indent-level)))
(if (< newdent 0)
0
newdent)))
(defun mlb-calculate-indent ()
(interactive)
(save-excursion
(goto-beginning-of-line-text)
(let ((curr-stmt-sym (mlb-move-read-sym))
(curr-stmt-indent (current-indentation)))
(beginning-of-line)
(let ((prev-stmt-sym (mlb-stmt-sym-backwards))
(prev-stmt-indent (current-indentation)))
;; (message "Prev: %s" prev-stmt-sym)
;; (message "Curr: %s" curr-stmt-sym)
(cond
((member prev-stmt-sym mlb-start-block-syms)
(cond
((member curr-stmt-sym mlb-close-syms)
prev-stmt-indent)
((member curr-stmt-sym mlb-start-block-syms)
(indent-1 prev-stmt-indent))
(t (indent-1 prev-stmt-indent))))
((member prev-stmt-sym mlb-close-syms)
(cond ((member curr-stmt-sym mlb-close-syms)
(outdent-1 prev-stmt-indent))
((member curr-stmt-sym mlb-start-block-syms)
prev-stmt-indent)
(t prev-stmt-indent)))
((member curr-stmt-sym mlb-close-syms)
(outdent-1 prev-stmt-indent))
(t prev-stmt-indent))))))
(defun mlb-move-read-sym ()
(interactive)
(let ((p0 (point)))
(mlb-forward-sym)
(when (/= (point) p0)
(buffer-substring-no-properties (point) p0))))
(defun mlb-forward-sym ()
(interactive)
(or (/= 0 (skip-syntax-forward "'w_"))
(/= 0 (skip-syntax-forward ".'"))))
(defun mlb-backward-read-sym ()
(interactive)
(let ((p0 (point)))
(mlb-backward-sym)
(when (/= (point) p0)
(buffer-substring-no-properties p0 (point)))))
(defun mlb-backward-sym ()
(interactive)
(or (/= 0 (skip-syntax-backward ".'"))
(/= 0 (skip-syntax-backward "'w_"))))
(defun mlb-back-to-outer-indent ()
"Unindents to the next outer level of indentation."
(interactive)
(save-excursion
(beginning-of-line)
(skip-chars-forward "\t ")
(let ((start-column (current-column))
(indent (current-column)))
(if (> start-column 0)
(progn
(save-excursion
(while (>= indent start-column)
(if (re-search-backward "^[^\n]" nil t)
(setq indent (current-indentation))
(setq indent 0))))
(backward-delete-char-untabify (- start-column indent)))))))
(defun mlb-indent-line ()
"Indent current MLB line of code."
(interactive)
(let ((savep (> (current-column) (current-indentation)))
(indent (or (mlb-calculate-indent) 0))) ;; (ignore-errors ...)
(if (> indent 0)
(if savep
(save-excursion (indent-line-to indent))
(indent-line-to indent))
(mlb-back-to-outer-indent))))
;;================
;; Setup MLB Mode
;;================
(defun mlb-mode-variables ()
(set (make-local-variable 'paragraph-start)
(concat "^[\t ]*$\\|" page-delimiter))
(set (make-local-variable 'paragraph-separate) paragraph-start)
(set (make-local-variable 'indent-line-function) 'mlb-indent-line)
(set (make-local-variable 'comment-start) "(* ")
(set (make-local-variable 'comment-end) " *)")
(set (make-local-variable 'comment-nested) t)
(set (make-local-variable 'comment-start-skip) "(\\*+\\s-*"))
(define-derived-mode mlb-mode fundamental-mode "MLB"
"\\<mlb-mode-map>Major mode for editing MLB declarations.
This mode runs `mlb-mode-hook' prior to exiting.
\\{mlb-mode-map}"
(set (make-local-variable 'font-lock-defaults) mlb-font-lock-defaults)
(mlb-mode-variables))