annotate src/elisp/urweb-defs.el @ 819:cb30dd2ba353

Switch to Maranget's pattern exhaustiveness algorithm
author Adam Chlipala <adamc@hcoop.net>
date Sat, 23 May 2009 09:45:02 -0400
parents 8998114760c1
children b2311dfb3158
rev   line source
adamc@350 1 ;;; urweb-defs.el --- Various definitions for urweb-mode
adamc@350 2
adamc@350 3 ;; Based on sml-mode:
adamc@350 4 ;; Copyright (C) 1999,2000,2003 Stefan Monnier <monnier@cs.yale.edu>
adamc@350 5 ;;
adamc@350 6 ;; Modified for urweb-mode:
adamc@350 7 ;; Copyright (C) 2008 Adam Chlipala <adamc@hcoop.net>
adamc@350 8 ;;
adamc@350 9 ;; This program is free software; you can redistribute it and/or modify
adamc@350 10 ;; it under the terms of the GNU General Public License as published by
adamc@350 11 ;; the Free Software Foundation; either version 2 of the License, or
adamc@350 12 ;; (at your option) any later version.
adamc@350 13 ;;
adamc@350 14 ;; This program is distributed in the hope that it will be useful,
adamc@350 15 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
adamc@350 16 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
adamc@350 17 ;; GNU General Public License for more details.
adamc@350 18 ;;
adamc@350 19 ;; You should have received a copy of the GNU General Public License
adamc@350 20 ;; along with this program; if not, write to the Free Software
adamc@350 21 ;; Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
adamc@350 22
adamc@350 23 ;;; Commentary:
adamc@350 24
adamc@350 25
adamc@350 26 ;;; Code:
adamc@350 27
adamc@350 28 (eval-when-compile (require 'cl))
adamc@414 29 (require 'urweb-util)
adamc@350 30
adamc@350 31
adamc@350 32 (defgroup urweb ()
adamc@350 33 "Editing Ur/Web code."
adamc@350 34 :group 'languages)
adamc@350 35
adamc@350 36 (defvar urweb-outline-regexp
adamc@350 37 ;; `st' and `si' are to match structure and signature.
adamc@350 38 " \\|s[ti]\\|[ \t]*\\(let[ \t]+\\)?\\(fun\\|and\\)\\>"
adamc@350 39 "Regexp matching a major heading.
adamc@350 40 This actually can't work without extending `outline-minor-mode' with the
adamc@350 41 notion of \"the end of an outline\".")
adamc@350 42
adamc@350 43 ;;;
adamc@350 44 ;;; Internal defines
adamc@350 45 ;;;
adamc@350 46
adamc@350 47 (defmap urweb-mode-map
adamc@350 48 ;; smarter cursor movement
adamc@350 49 '(("\C-c\C-i" . urweb-mode-info))
adamc@350 50 "The keymap used in `urweb-mode'."
adamc@350 51 ;; :inherit urweb-bindings
adamc@350 52 :group 'urweb)
adamc@350 53
adamc@350 54 (defsyntax urweb-mode-syntax-table
adamc@350 55 `((?\* . ,(if urweb-builtin-nested-comments-flag ". 23n" ". 23"))
adamc@350 56 (?\( . "()1")
adamc@350 57 (?\) . ")(4")
adamc@350 58 ("._'" . "_")
adamc@350 59 (",;" . ".")
adamc@350 60 ;; `!' is not really a prefix-char, oh well!
adamc@350 61 ("~#!" . "'")
adamc@350 62 ("%&$+-/:<=>?@`^|" . "."))
adamc@350 63 "The syntax table used in `urweb-mode'.")
adamc@350 64
adamc@350 65
adamc@350 66 (easy-menu-define urweb-mode-menu urweb-mode-map "Menu used in `urweb-mode'."
adamc@351 67 '("Ur/Web"
adamc@351 68 ["Ur/Web mode help (brief)" describe-mode t]
adamc@351 69 ["Ur/Web mode *info*" urweb-mode-info t]
adamc@350 70 ))
adamc@350 71
adamc@350 72 ;; Make's sure they appear in the menu bar when urweb-mode-map is active.
adamc@350 73 ;; On the hook for XEmacs only -- see easy-menu-add in auc-menu.el.
adamc@350 74 ;; (defun urweb-mode-menu-bar ()
adamc@350 75 ;; "Make sure menus appear in the menu bar as well as under mouse 3."
adamc@350 76 ;; (and (eq major-mode 'urweb-mode)
adamc@350 77 ;; (easy-menu-add urweb-mode-menu urweb-mode-map)))
adamc@350 78 ;; (add-hook 'urweb-mode-hook 'urweb-mode-menu-bar)
adamc@350 79
adamc@350 80 ;;
adamc@350 81 ;; regexps
adamc@350 82 ;;
adamc@350 83
adamc@350 84 (defun urweb-syms-re (&rest syms)
adamc@350 85 (concat "\\<" (regexp-opt (flatten syms) t) "\\>"))
adamc@350 86
adamc@350 87 ;;
adamc@350 88
adamc@350 89 (defconst urweb-module-head-syms
adamc@350 90 '("signature" "structure" "functor"))
adamc@350 91
adamc@350 92
adamc@350 93 (defconst urweb-begin-syms
adamc@446 94 '("let" "struct" "sig")
adamc@350 95 "Symbols matching the `end' symbol.")
adamc@350 96
adamc@350 97 (defconst urweb-begin-syms-re
adamc@350 98 (urweb-syms-re urweb-begin-syms)
adamc@350 99 "Symbols matching the `end' symbol.")
adamc@350 100
adamc@350 101 ;; (defconst urweb-user-begin-symbols-re
adamc@350 102 ;; (urweb-syms-re "let" "abstype" "local" "struct" "sig" "in" "with")
adamc@350 103 ;; "Symbols matching (loosely) the `end' symbol.")
adamc@350 104
adamc@350 105 (defconst urweb-sexp-head-symbols-re
adamc@446 106 (urweb-syms-re "let" "struct" "sig" "in" "with"
adamc@446 107 "if" "then" "else" "case" "of" "fn" "fun" "val" "and"
adamc@446 108 "datatype" "type" "open" "include"
adamc@446 109 urweb-module-head-syms
adamc@621 110 "con" "map" "where" "extern" "constraint" "constraints"
adamc@459 111 "table" "sequence" "class" "cookie")
adamc@350 112 "Symbols starting an sexp.")
adamc@350 113
adamc@350 114 ;; (defconst urweb-not-arg-start-re
adamc@350 115 ;; (urweb-syms-re "in" "of" "end" "andalso")
adamc@350 116 ;; "Symbols that can't be found at the head of an arg.")
adamc@350 117
adamc@350 118 ;; (defconst urweb-not-arg-re
adamc@350 119 ;; (urweb-syms-re "in" "of" "end" "andalso")
adamc@350 120 ;; "Symbols that should not be confused with an arg.")
adamc@350 121
adamc@350 122 (defconst urweb-=-starter-syms
adamc@350 123 (list* "|" "val" "fun" "and" "datatype" "con" "type" "class"
adamc@350 124 urweb-module-head-syms)
adamc@350 125 "Symbols that can be followed by a `='.")
adamc@350 126 (defconst urweb-=-starter-re
adamc@350 127 (concat "\\S.|\\S.\\|" (urweb-syms-re (cdr urweb-=-starter-syms)))
adamc@350 128 "Symbols that can be followed by a `='.")
adamc@350 129
adamc@350 130 (defconst urweb-indent-rule
adamc@350 131 (urweb-preproc-alist
adamc@350 132 `((,urweb-module-head-syms "d=" 0)
adamc@350 133 ("if" "else" 0)
adamc@350 134 (,urweb-=-starter-syms nil)
adamc@350 135 (("case" "datatype" "if" "then" "else"
adamc@446 136 "let" "open" "sig" "struct" "type" "val"
adamc@459 137 "con" "constraint" "table" "sequence" "class" "cookie")))))
adamc@350 138
adamc@350 139 (defconst urweb-starters-indent-after
adamc@446 140 (urweb-syms-re "let" "in" "struct" "sig")
adamc@350 141 "Indent after these.")
adamc@350 142
adamc@350 143 (defconst urweb-delegate
adamc@350 144 (urweb-preproc-alist
adamc@350 145 `((("of" "else" "then" "with" "d=") . (not (urweb-bolp)))
adamc@350 146 ("in" . t)))
adamc@350 147 "Words which might delegate indentation to their parent.")
adamc@350 148
adamc@350 149 (defcustom urweb-symbol-indent
adamc@350 150 '(("fn" . -3)
adamc@350 151 ("of" . 1)
adamc@350 152 ("|" . -2)
adamc@350 153 ("," . -2)
adamc@350 154 (";" . -2)
adamc@350 155 ;;("in" . 1)
adamc@350 156 ("d=" . 2))
adamc@350 157 "Special indentation alist for some symbols.
adamc@350 158 An entry like (\"in\" . 1) indicates that a line starting with the
adamc@350 159 symbol `in' should be indented one char further to the right.
adamc@350 160 This is only used in a few specific cases, so it does not work
adamc@350 161 for all symbols and in all lines starting with the given symbol."
adamc@350 162 :group 'urweb
adamc@350 163 :type '(repeat (cons string integer)))
adamc@350 164
adamc@350 165 (defconst urweb-open-paren
adamc@350 166 (urweb-preproc-alist
adamc@446 167 `((,(list* "in" urweb-begin-syms) ,urweb-begin-syms-re "\\<end\\>")))
adamc@350 168 "Symbols that should behave somewhat like opening parens.")
adamc@350 169
adamc@350 170 (defconst urweb-close-paren
adamc@446 171 `(("in" "\\<let\\>")
adamc@446 172 ("end" ,urweb-begin-syms-re)
adamc@350 173 ("then" "\\<if\\>")
adamc@350 174 ("else" "\\<if\\>" (urweb-bolp))
adamc@350 175 ("of" "\\<case\\>")
adamc@366 176 ("</xml>" "<xml>")
adamc@350 177 ("d=" nil))
adamc@350 178 "Symbols that should behave somewhat like close parens.")
adamc@350 179
adamc@350 180 (defconst urweb-agglomerate-re "\\<else[ \t]+if\\>"
adamc@350 181 "Regexp of compound symbols (pairs of symbols to be considered as one).")
adamc@350 182
adamc@350 183 (defconst urweb-non-nested-of-starter-re
adamc@350 184 (urweb-syms-re "datatype")
adamc@350 185 "Symbols that can introduce an `of' that shouldn't behave like a paren.")
adamc@350 186
adamc@350 187 (defconst urweb-starters-syms
adamc@350 188 (append urweb-module-head-syms
adamc@350 189 '("datatype" "fun"
adamc@350 190 "open" "type" "val" "and"
adamc@459 191 "con" "constraint" "table" "sequence" "class" "cookie"))
adamc@350 192 "The starters of new expressions.")
adamc@350 193
adamc@350 194 (defconst urweb-exptrail-syms
adamc@621 195 '("if" "then" "else" "case" "of" "fn" "with" "map"))
adamc@350 196
adamc@350 197 (defconst urweb-pipeheads
adamc@350 198 '("|" "of" "fun" "fn" "and" "datatype")
adamc@350 199 "A `|' corresponds to one of these.")
adamc@350 200
adamc@350 201
adamc@350 202 (provide 'urweb-defs)
adamc@350 203
adamc@350 204 ;;; urweb-defs.el ends here