Mercurial > urweb

annotate src/elisp/urweb-defs.el @ 2201:1091227f535a

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Unnest properly in presence of kind polymorphism
author Adam Chlipala <adam@chlipala.net>
date Sun, 20 Dec 2015 13:41:35 -0500
parents 53f91b67006c
children
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"
julian@2141 111 "table" "sequence" "class" "cookie" "style" "task" "policy")
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@1073 137 "con" "constraint" "table" "sequence" "class" "cookie"
julian@2141 138 "style" "task" "policy")))))
adamc@350 139
adamc@350 140 (defconst urweb-starters-indent-after
adamc@446 141 (urweb-syms-re "let" "in" "struct" "sig")
adamc@350 142 "Indent after these.")
adamc@350 143
adamc@350 144 (defconst urweb-delegate
adamc@350 145 (urweb-preproc-alist
adamc@350 146 `((("of" "else" "then" "with" "d=") . (not (urweb-bolp)))
adamc@350 147 ("in" . t)))
adamc@350 148 "Words which might delegate indentation to their parent.")
adamc@350 149
adamc@350 150 (defcustom urweb-symbol-indent
adamc@350 151 '(("fn" . -3)
adamc@350 152 ("of" . 1)
adamc@350 153 ("|" . -2)
adamc@350 154 ("," . -2)
adamc@350 155 (";" . -2)
adamc@350 156 ;;("in" . 1)
adamc@350 157 ("d=" . 2))
adamc@350 158 "Special indentation alist for some symbols.
adamc@350 159 An entry like (\"in\" . 1) indicates that a line starting with the
adamc@350 160 symbol `in' should be indented one char further to the right.
adamc@350 161 This is only used in a few specific cases, so it does not work
adamc@350 162 for all symbols and in all lines starting with the given symbol."
adamc@350 163 :group 'urweb
adamc@350 164 :type '(repeat (cons string integer)))
adamc@350 165
adamc@350 166 (defconst urweb-open-paren
adamc@350 167 (urweb-preproc-alist
adamc@446 168 `((,(list* "in" urweb-begin-syms) ,urweb-begin-syms-re "\\<end\\>")))
adamc@350 169 "Symbols that should behave somewhat like opening parens.")
adamc@350 170
adamc@350 171 (defconst urweb-close-paren
adamc@446 172 `(("in" "\\<let\\>")
adamc@446 173 ("end" ,urweb-begin-syms-re)
adamc@350 174 ("then" "\\<if\\>")
adamc@350 175 ("else" "\\<if\\>" (urweb-bolp))
adamc@350 176 ("of" "\\<case\\>")
adamc@366 177 ("</xml>" "<xml>")
adamc@350 178 ("d=" nil))
adamc@350 179 "Symbols that should behave somewhat like close parens.")
adamc@350 180
adamc@350 181 (defconst urweb-agglomerate-re "\\<else[ \t]+if\\>"
adamc@350 182 "Regexp of compound symbols (pairs of symbols to be considered as one).")
adamc@350 183
adamc@350 184 (defconst urweb-non-nested-of-starter-re
adamc@350 185 (urweb-syms-re "datatype")
adamc@350 186 "Symbols that can introduce an `of' that shouldn't behave like a paren.")
adamc@350 187
adamc@350 188 (defconst urweb-starters-syms
adamc@350 189 (append urweb-module-head-syms
adamc@350 190 '("datatype" "fun"
adamc@350 191 "open" "type" "val" "and"
adamc@1073 192 "con" "constraint" "table" "sequence" "class" "cookie"
julian@2141 193 "style" "task" "policy"))
adamc@350 194 "The starters of new expressions.")
adamc@350 195
adamc@350 196 (defconst urweb-exptrail-syms
adamc@621 197 '("if" "then" "else" "case" "of" "fn" "with" "map"))
adamc@350 198
adamc@350 199 (defconst urweb-pipeheads
adamc@350 200 '("|" "of" "fun" "fn" "and" "datatype")
adamc@350 201 "A `|' corresponds to one of these.")
adamc@350 202
adamc@350 203
adamc@350 204 (provide 'urweb-defs)
adamc@350 205
adamc@350 206 ;;; urweb-defs.el ends here