adamc@350: ;;; urweb-defs.el --- Various definitions for urweb-mode
adamc@350: 
adamc@350: ;; Based on sml-mode:
adamc@350: ;; Copyright (C) 1999,2000,2003  Stefan Monnier <monnier@cs.yale.edu>
adamc@350: ;;
adamc@350: ;; Modified for urweb-mode:
adamc@350: ;; Copyright (C) 2008  Adam Chlipala <adamc@hcoop.net>
adamc@350: ;;
adamc@350: ;; This program is free software; you can redistribute it and/or modify
adamc@350: ;; it under the terms of the GNU General Public License as published by
adamc@350: ;; the Free Software Foundation; either version 2 of the License, or
adamc@350: ;; (at your option) any later version.
adamc@350: ;;
adamc@350: ;; This program is distributed in the hope that it will be useful,
adamc@350: ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
adamc@350: ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
adamc@350: ;; GNU General Public License for more details.
adamc@350: ;;
adamc@350: ;; You should have received a copy of the GNU General Public License
adamc@350: ;; along with this program; if not, write to the Free Software
adamc@350: ;; Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
adamc@350: 
adamc@350: ;;; Commentary:
adamc@350: 
adamc@350: 
adamc@350: ;;; Code:
adamc@350: 
adamc@350: (eval-when-compile (require 'cl))
adamc@414: (require 'urweb-util)
adamc@350: 
adamc@350: 
adamc@350: (defgroup urweb ()
adamc@350:   "Editing Ur/Web code."
adamc@350:   :group 'languages)
adamc@350: 
adamc@350: (defvar urweb-outline-regexp
adamc@350:   ;; `st' and `si' are to match structure and signature.
adamc@350:   "\\|s[ti]\\|[ \t]*\\(let[ \t]+\\)?\\(fun\\|and\\)\\>"
adamc@350:   "Regexp matching a major heading.
adamc@350: This actually can't work without extending `outline-minor-mode' with the
adamc@350: notion of \"the end of an outline\".")
adamc@350: 
adamc@350: ;;; 
adamc@350: ;;; Internal defines
adamc@350: ;;; 
adamc@350: 
adamc@350: (defmap urweb-mode-map
adamc@350:   ;; smarter cursor movement
adamc@350:   '(("\C-c\C-i"	. urweb-mode-info))
adamc@350:   "The keymap used in `urweb-mode'."
adamc@350:   ;; :inherit urweb-bindings
adamc@350:   :group 'urweb)
adamc@350: 
adamc@350: (defsyntax urweb-mode-syntax-table
adamc@350:   `((?\*   . ,(if urweb-builtin-nested-comments-flag ". 23n" ". 23"))
adamc@350:     (?\(   . "()1")
adamc@350:     (?\)   . ")(4")
adamc@350:     ("._'" . "_")
adamc@350:     (",;"  . ".")
adamc@350:     ;; `!' is not really a prefix-char, oh well!
adamc@350:     ("~#!" . "'")
adamc@350:     ("%&$+-/:<=>?@`^|"	 . "."))
adamc@350:   "The syntax table used in `urweb-mode'.")
adamc@350: 
adamc@350: 
adamc@350: (easy-menu-define urweb-mode-menu urweb-mode-map "Menu used in `urweb-mode'."
adamc@351:   '("Ur/Web"
adamc@351:     ["Ur/Web mode help (brief)"       describe-mode t]
adamc@351:     ["Ur/Web mode *info*"             urweb-mode-info t]
adamc@350:     ))
adamc@350: 
adamc@350: ;; Make's sure they appear in the menu bar when urweb-mode-map is active.
adamc@350: ;; On the hook for XEmacs only -- see easy-menu-add in auc-menu.el.
adamc@350: ;; (defun urweb-mode-menu-bar ()
adamc@350: ;;   "Make sure menus appear in the menu bar as well as under mouse 3."
adamc@350: ;;   (and (eq major-mode 'urweb-mode)
adamc@350: ;;        (easy-menu-add urweb-mode-menu urweb-mode-map)))
adamc@350: ;; (add-hook 'urweb-mode-hook 'urweb-mode-menu-bar)
adamc@350: 
adamc@350: ;;
adamc@350: ;; regexps
adamc@350: ;;
adamc@350: 
adamc@350: (defun urweb-syms-re (&rest syms)
adamc@350:   (concat "\\<" (regexp-opt (flatten syms) t) "\\>"))
adamc@350: 
adamc@350: ;;
adamc@350: 
adamc@350: (defconst urweb-module-head-syms
adamc@350:   '("signature" "structure" "functor"))
adamc@350: 
adamc@350: 
adamc@350: (defconst urweb-begin-syms
adamc@446:   '("let" "struct" "sig")
adamc@350:   "Symbols matching the `end' symbol.")
adamc@350: 
adamc@350: (defconst urweb-begin-syms-re
adamc@350:   (urweb-syms-re urweb-begin-syms)
adamc@350:   "Symbols matching the `end' symbol.")
adamc@350: 
adamc@350: ;; (defconst urweb-user-begin-symbols-re
adamc@350: ;;   (urweb-syms-re "let" "abstype" "local" "struct" "sig" "in" "with")
adamc@350: ;;   "Symbols matching (loosely) the `end' symbol.")
adamc@350: 
adamc@350: (defconst urweb-sexp-head-symbols-re
adamc@446:   (urweb-syms-re "let" "struct" "sig" "in" "with"
adamc@446:                  "if" "then" "else" "case" "of" "fn" "fun" "val" "and"
adamc@446:                  "datatype" "type" "open" "include"
adamc@446:                  urweb-module-head-syms
adamc@621:                  "con" "map" "where" "extern" "constraint" "constraints"
julian@2141:                  "table" "sequence" "class" "cookie" "style" "task" "policy")
adamc@350:   "Symbols starting an sexp.")
adamc@350: 
adamc@350: ;; (defconst urweb-not-arg-start-re
adamc@350: ;;   (urweb-syms-re "in" "of" "end" "andalso")
adamc@350: ;;   "Symbols that can't be found at the head of an arg.")
adamc@350: 
adamc@350: ;; (defconst urweb-not-arg-re
adamc@350: ;;   (urweb-syms-re "in" "of" "end" "andalso")
adamc@350: ;;   "Symbols that should not be confused with an arg.")
adamc@350: 
adamc@350: (defconst urweb-=-starter-syms
adamc@350:   (list* "|" "val" "fun" "and" "datatype" "con" "type" "class"
adamc@350: 	 urweb-module-head-syms)
adamc@350:   "Symbols that can be followed by a `='.")
adamc@350: (defconst urweb-=-starter-re
adamc@350:   (concat "\\S.|\\S.\\|" (urweb-syms-re (cdr urweb-=-starter-syms)))
adamc@350:   "Symbols that can be followed by a `='.")
adamc@350: 
adamc@350: (defconst urweb-indent-rule
adamc@350:   (urweb-preproc-alist
adamc@350:    `((,urweb-module-head-syms "d=" 0)
adamc@350:      ("if" "else" 0)
adamc@350:      (,urweb-=-starter-syms nil)
adamc@350:      (("case" "datatype" "if" "then" "else"
adamc@446:        "let" "open" "sig" "struct" "type" "val"
adamc@1073:        "con" "constraint" "table" "sequence" "class" "cookie"
julian@2141:        "style" "task" "policy")))))
adamc@350: 
adamc@350: (defconst urweb-starters-indent-after
adamc@446:   (urweb-syms-re "let" "in" "struct" "sig")
adamc@350:   "Indent after these.")
adamc@350: 
adamc@350: (defconst urweb-delegate
adamc@350:   (urweb-preproc-alist
adamc@350:    `((("of" "else" "then" "with" "d=") . (not (urweb-bolp)))
adamc@350:      ("in" . t)))
adamc@350:   "Words which might delegate indentation to their parent.")
adamc@350: 
adamc@350: (defcustom urweb-symbol-indent
adamc@350:   '(("fn" . -3)
adamc@350:     ("of" . 1)
adamc@350:     ("|" . -2)
adamc@350:     ("," . -2)
adamc@350:     (";" . -2)
adamc@350:     ;;("in" . 1)
adamc@350:     ("d=" . 2))
adamc@350:   "Special indentation alist for some symbols.
adamc@350: An entry like (\"in\" . 1) indicates that a line starting with the
adamc@350: symbol `in' should be indented one char further to the right.
adamc@350: This is only used in a few specific cases, so it does not work
adamc@350: for all symbols and in all lines starting with the given symbol."
adamc@350:   :group 'urweb
adamc@350:   :type '(repeat (cons string integer)))
adamc@350: 
adamc@350: (defconst urweb-open-paren
adamc@350:   (urweb-preproc-alist
adamc@446:    `((,(list* "in" urweb-begin-syms) ,urweb-begin-syms-re "\\<end\\>")))
adamc@350:   "Symbols that should behave somewhat like opening parens.")
adamc@350: 
adamc@350: (defconst urweb-close-paren
adamc@446:   `(("in" "\\<let\\>")
adamc@446:     ("end" ,urweb-begin-syms-re)
adamc@350:     ("then" "\\<if\\>")
adamc@350:     ("else" "\\<if\\>" (urweb-bolp))
adamc@350:     ("of" "\\<case\\>")
adamc@366:     ("</xml>" "<xml>")
adamc@350:     ("d=" nil))
adamc@350:   "Symbols that should behave somewhat like close parens.")
adamc@350: 
adamc@350: (defconst urweb-agglomerate-re "\\<else[ \t]+if\\>"
adamc@350:   "Regexp of compound symbols (pairs of symbols to be considered as one).")
adamc@350: 
adamc@350: (defconst urweb-non-nested-of-starter-re
adamc@350:   (urweb-syms-re "datatype")
adamc@350:   "Symbols that can introduce an `of' that shouldn't behave like a paren.")
adamc@350: 
adamc@350: (defconst urweb-starters-syms
adamc@350:   (append urweb-module-head-syms
adamc@350: 	  '("datatype" "fun"
adamc@350: 	    "open" "type" "val" "and"
adamc@1073: 	    "con" "constraint" "table" "sequence" "class" "cookie"
julian@2141:             "style" "task" "policy"))
adamc@350:   "The starters of new expressions.")
adamc@350: 
adamc@350: (defconst urweb-exptrail-syms
adamc@621:   '("if" "then" "else" "case" "of" "fn" "with" "map"))
adamc@350: 
adamc@350: (defconst urweb-pipeheads
adamc@350:    '("|" "of" "fun" "fn" "and" "datatype")
adamc@350:    "A `|' corresponds to one of these.")
adamc@350: 
adamc@350: 
adamc@350: (provide 'urweb-defs)
adamc@350: 
adamc@350: ;;; urweb-defs.el ends here