| 1 | ;; cforall.el --- major mode for editing CForAll (.cf or .cfa) files
|
|---|
| 2 | ;; (right now, only some syntax highlighting and indentation)
|
|---|
| 3 |
|
|---|
| 4 | ;; This file is *NOT* part of GNU Emacs.
|
|---|
| 5 |
|
|---|
| 6 | ;; Extension to Barry Warsaw's cc-mode (plus fontification)
|
|---|
| 7 |
|
|---|
| 8 | ;; To use, add this file somewhere in `load-path' and put the following lines in .emacs
|
|---|
| 9 | ;;
|
|---|
| 10 | ;; (autoload 'CFA-mode "cforall" "CForAll mode" t)
|
|---|
| 11 | ;; (setq auto-mode-alist (append '(("\\.cfa?$" . CFA-mode))
|
|---|
| 12 | ;; auto-mode-alist))
|
|---|
| 13 |
|
|---|
| 14 |
|
|---|
| 15 | (provide 'CFA-mode)
|
|---|
| 16 |
|
|---|
| 17 | (require 'cc-mode)
|
|---|
| 18 | (require 'font-lock)
|
|---|
| 19 |
|
|---|
| 20 | (eval-when-compile
|
|---|
| 21 | (require 'cc-mode)
|
|---|
| 22 | (require 'font-lock)
|
|---|
| 23 | )
|
|---|
| 24 |
|
|---|
| 25 | (defconst c-CFA-extra-toplevel-key c-extra-toplevel-key )
|
|---|
| 26 | (defconst c-CFA-attrib-key (concat "\[" c-symbol-key "\\(([^)]*)\\)?\]"))
|
|---|
| 27 | (defconst c-CFA-class-key c-class-key )
|
|---|
| 28 | (defconst c-CFA-conditional-key c-conditional-key)
|
|---|
| 29 | (defconst c-CFA-access-key c-access-key)
|
|---|
| 30 | (defconst c-CFA-comment-start-regexp c-comment-start-regexp )
|
|---|
| 31 |
|
|---|
| 32 | (defvar CFA-mode-abbrev-table nil
|
|---|
| 33 | "Abbreviation table used in CFA-mode buffers.")
|
|---|
| 34 | (define-abbrev-table 'CFA-mode-abbrev-table ())
|
|---|
| 35 |
|
|---|
| 36 | (defvar CFA-mode-map ()
|
|---|
| 37 | "Keymap used in CFA-mode buffers.")
|
|---|
| 38 | (if CFA-mode-map
|
|---|
| 39 | nil
|
|---|
| 40 | (setq CFA-mode-map (c-make-inherited-keymap))
|
|---|
| 41 | )
|
|---|
| 42 |
|
|---|
| 43 | (defvar CFA-mode-syntax-table nil
|
|---|
| 44 | "Syntax table used in CFA-mode buffers.")
|
|---|
| 45 | (if CFA-mode-syntax-table
|
|---|
| 46 | ()
|
|---|
| 47 | (setq CFA-mode-syntax-table (make-syntax-table))
|
|---|
| 48 | (c-populate-syntax-table CFA-mode-syntax-table))
|
|---|
| 49 | (modify-syntax-entry ?@ "_" CFA-mode-syntax-table)
|
|---|
| 50 | (modify-syntax-entry ?. "_" CFA-mode-syntax-table)
|
|---|
| 51 | (modify-syntax-entry ?. "w" CFA-mode-syntax-table)
|
|---|
| 52 |
|
|---|
| 53 | (easy-menu-define c-CFA-menu CFA-mode-map "CFA Mode Commands"
|
|---|
| 54 | (c-mode-menu "CFA"))
|
|---|
| 55 |
|
|---|
| 56 | (defcustom CFA-mode-hook nil
|
|---|
| 57 | "*Hook called by `CFA-mode'."
|
|---|
| 58 | :type 'hook
|
|---|
| 59 | :group 'c)
|
|---|
| 60 |
|
|---|
| 61 | ;; Font lock support
|
|---|
| 62 | (defcustom CFA-font-lock-extra-types
|
|---|
| 63 | '()
|
|---|
| 64 | "*List of extra types to fontify in CFA mode.
|
|---|
| 65 | Each list item should be a regexp not containing word-delimiters.
|
|---|
| 66 | For example, a value of (\"System\") means the word string is treated as a type
|
|---|
| 67 | name.
|
|---|
| 68 | The value of this variable is used when Font Lock mode is turned on."
|
|---|
| 69 | :type 'font-lock-extra-types-widget
|
|---|
| 70 | :group 'font-lock-extra-types)
|
|---|
| 71 | (defconst CFA-font-lock-keywords-1 nil
|
|---|
| 72 | "Subdued level highlighting for CFA mode.")
|
|---|
| 73 | (defconst CFA-font-lock-keywords-2 nil
|
|---|
| 74 | "Medium level highlighting for CFA mode.
|
|---|
| 75 | See also `CFA-font-lock-extra-types'.")
|
|---|
| 76 | (defconst CFA-font-lock-keywords-3 nil
|
|---|
| 77 | "Gaudy level highlighting for CFA mode.
|
|---|
| 78 | See also `CFA-font-lock-extra-types'.")
|
|---|
| 79 |
|
|---|
| 80 |
|
|---|
| 81 | ;; Auxiliary functions (change this)
|
|---|
| 82 | ;; (defun font-lock-match-CFA-style-declaration-item-and-skip-to-next (limit)
|
|---|
| 83 | ;; ;; Regexp matches after point: word<word>::word (
|
|---|
| 84 | ;; ;; ^^^^ ^^^^ ^^^^ ^
|
|---|
| 85 | ;; ;; Where the match subexpressions are: 1 3 5 6
|
|---|
| 86 | ;; ;;
|
|---|
| 87 | ;; ;; Item is delimited by (match-beginning 1) and (match-end 1).
|
|---|
| 88 | ;; ;; If (match-beginning 3) is non-nil, that part of the item incloses a `<>'.
|
|---|
| 89 | ;; ;; If (match-beginning 5) is non-nil, that part of the item follows a `::'.
|
|---|
| 90 | ;; ;; If (match-beginning 6) is non-nil, the item is followed by a `('.
|
|---|
| 91 | ;; (when (looking-at (eval-when-compile
|
|---|
| 92 | ;; (concat
|
|---|
| 93 | ;; ;; Skip any leading whitespace.
|
|---|
| 94 | ;; "[ \t*&]*"
|
|---|
| 95 | ;; ;; This is `c++-type-spec' from below. (Hint hint!)
|
|---|
| 96 | ;; "\\(\\sw+\\)" ; The instance?
|
|---|
| 97 | ;; "\\([ \t]*<\\([^>\n]+\\)[ \t*&]*>\\)?" ; Or template?
|
|---|
| 98 | ;; "\\([ \t]*::[ \t*~]*\\(\\sw+\\)\\)*" ; Or member?
|
|---|
| 99 | ;; ;; Match any trailing parenthesis.
|
|---|
| 100 | ;; "[ \t]*\\((\\)?")))
|
|---|
| 101 | ;; (save-match-data
|
|---|
| 102 | ;; (condition-case nil
|
|---|
| 103 | ;; (save-restriction
|
|---|
| 104 | ;; ;; Restrict to the end of line, currently guaranteed to be LIMIT.
|
|---|
| 105 | ;; (narrow-to-region (point-min) limit)
|
|---|
| 106 | ;; (goto-char (match-end 1))
|
|---|
| 107 | ;; ;; Move over any item value, etc., to the next item.
|
|---|
| 108 | ;; (while (not (looking-at "[ \t]*\\(\\(,\\)\\|;\\|$\\)"))
|
|---|
| 109 | ;; (goto-char (or (scan-sexps (point) 1) (point-max))))
|
|---|
| 110 | ;; (goto-char (match-end 2)))
|
|---|
| 111 | ;; (error t)))))
|
|---|
| 112 |
|
|---|
| 113 |
|
|---|
| 114 | (let* ((CFA-keywords
|
|---|
| 115 | (eval-when-compile
|
|---|
| 116 | (regexp-opt
|
|---|
| 117 | (list
|
|---|
| 118 | ;; Statements
|
|---|
| 119 | "break" "catch" "choose" "context"
|
|---|
| 120 | "continue" "do" "else" "fallthru" "for" "if" "return"
|
|---|
| 121 | "sizeof" "switch" "throw" "try" ;c-cfa-typeof-re
|
|---|
| 122 | "while"
|
|---|
| 123 | ;; Storage classes
|
|---|
| 124 | "auto" "extern" "register" "static"
|
|---|
| 125 | "inline" "__inline" "__inline__" "fortran"
|
|---|
| 126 | ;; Typedef
|
|---|
| 127 | "typedef"
|
|---|
| 128 | ;; Type classes
|
|---|
| 129 | "type" "dtype" "ftype"
|
|---|
| 130 | ;; Type qualifiers
|
|---|
| 131 | "const" "__const" "__const__" "restrict" "volatile" "__volatile"
|
|---|
| 132 | "__volatile__" "lvalue" "forall"
|
|---|
| 133 | ) t)))
|
|---|
| 134 |
|
|---|
| 135 | (CFA-reserved-words '());(eval-when-compile (regexp-opt '() t)))
|
|---|
| 136 |
|
|---|
| 137 | (CFA-type-names
|
|---|
| 138 | `(mapconcat 'identity
|
|---|
| 139 | (cons
|
|---|
| 140 | (,@ (eval-when-compile
|
|---|
| 141 | (regexp-opt '("char" "short" "int" "long"
|
|---|
| 142 | "float" "double" "void"
|
|---|
| 143 | "unsigned"
|
|---|
| 144 | ))))
|
|---|
| 145 | CFA-font-lock-extra-types)
|
|---|
| 146 | "\\|"))
|
|---|
| 147 | (CFA-type-names-depth `(regexp-opt-depth (,@ CFA-type-names)))
|
|---|
| 148 |
|
|---|
| 149 | ;; (CFA-ops
|
|---|
| 150 | ;; (eval-when-compile
|
|---|
| 151 | ;; (regexp-opt
|
|---|
| 152 | ;; '("." "+" "-" "*" "/" "%" "^" "&" "|" "~" "!" "=" "<" ">" "+=" "-="
|
|---|
| 153 | ;; "*=" "/=" "%=" "^=" "&=" "|=" "<<" ">>" ">>=" "<<=" "==" "!="
|
|---|
| 154 | ;; "<=" ">=" "&&" "||" "++" "--"))))
|
|---|
| 155 |
|
|---|
| 156 | (CFA-ops-names
|
|---|
| 157 | (eval-when-compile
|
|---|
| 158 | (regexp-opt
|
|---|
| 159 | (list
|
|---|
| 160 | ;; diadic
|
|---|
| 161 | "?+?" "\?-\?" "?*?" "?/?" "?%?" "?|?" "?&?" "?^?" "?<<?" "?>>?"
|
|---|
| 162 | "?<?" "?>?" "?<=?" "?>=?" "?==?" "?!=?" "?=?" "?*=?" "?/=?"
|
|---|
| 163 | "?%=?" "?+=?" "?-=?" "?<<=?" "?>>=?" "?&=?" "?^=?" "?|=?"
|
|---|
| 164 | "?[?]"
|
|---|
| 165 | ;; monadic
|
|---|
| 166 | "+?" "-?" "*?" "!?" "~?" "++?" "?++" "--?" "?--"
|
|---|
| 167 | ))))
|
|---|
| 168 |
|
|---|
| 169 | ; defined so as to make it independent of the syntax table
|
|---|
| 170 | ; (and allow users to knock themselves out figuring out new word definitions)
|
|---|
| 171 | (CFA-valid-identifier "[[:alpha:]][[:alnum:]]*")
|
|---|
| 172 |
|
|---|
| 173 | (CFA-preprocessor-directives
|
|---|
| 174 | (eval-when-compile
|
|---|
| 175 | (regexp-opt
|
|---|
| 176 | '("define" "elif" "else" "endif" "error" "file" "if" "ifdef"
|
|---|
| 177 | "ifndef" "include" "line" "pragma" "undef"))))
|
|---|
| 178 | (CFA-preprocessor-directives-depth
|
|---|
| 179 | (regexp-opt-depth CFA-preprocessor-directives))
|
|---|
| 180 | )
|
|---|
| 181 |
|
|---|
| 182 | (setq CFA-font-lock-keywords-1
|
|---|
| 183 | (list
|
|---|
| 184 | ;; Fontify function names.
|
|---|
| 185 | (list
|
|---|
| 186 | (concat "\\(" CFA-ops-names "\\)")
|
|---|
| 187 | '(1 font-lock-function-name-face nil t))
|
|---|
| 188 |
|
|---|
| 189 | ;;; Preprocessor directives
|
|---|
| 190 | ;; Fontify filenames in #include <...> preprocessor directives as strings.
|
|---|
| 191 | '("^[ \t]*#[ \t]*\\(include\\)[ \t]*\\(<[^>\"\n]*>?\\)" 2 font-lock-string-face)
|
|---|
| 192 | ;; Fontify function macro names.
|
|---|
| 193 | '("^#[ \t]*define[ \t]+\\(\\sw+\\)(" 1 font-lock-function-name-face)
|
|---|
| 194 | ;; ;;
|
|---|
| 195 | ;; ;; Fontify symbol names in #elif or #if ... defined preprocessor directives.
|
|---|
| 196 | ;; '("^#[ \t]*\\(elif\\|if\\)\\>"
|
|---|
| 197 | ;; ("\\<\\(defined\\)\\>[ \t]*(?\\(\\sw+\\)?" nil nil
|
|---|
| 198 | ;; (1 font-lock-builtin-face) (2 font-lock-variable-name-face nil t)))
|
|---|
| 199 | ;; ;;
|
|---|
| 200 | ;; ;; Fontify otherwise as symbol names, and the preprocessor directive names.
|
|---|
| 201 | (list
|
|---|
| 202 | (concat "^[ \t]*#[ \t]*\\(" CFA-preprocessor-directives ;; check number of spaces surrounding pound sign
|
|---|
| 203 | "\\)\\>[ \t!]*\\(\\sw+\\)?")
|
|---|
| 204 | '(1 font-lock-builtin-face))
|
|---|
| 205 | ;; (list (+ 2 c-preprocessor-directives-depth)
|
|---|
| 206 | ;; 'font-lock-variable-name-face nil t))
|
|---|
| 207 | ))
|
|---|
| 208 |
|
|---|
| 209 | (setq CFA-font-lock-keywords-2
|
|---|
| 210 | (append CFA-font-lock-keywords-1
|
|---|
| 211 | (list
|
|---|
| 212 | ;; Fontify all builtin keywords (except below).
|
|---|
| 213 | (concat "\\<\\(" CFA-keywords "\\)\\>")
|
|---|
| 214 |
|
|---|
| 215 | ;; Fontify types
|
|---|
| 216 | `(eval .
|
|---|
| 217 | (cons (concat "\\<\\(" (,@ CFA-type-names) "\\)\\>")
|
|---|
| 218 | '(1 font-lock-type-face)
|
|---|
| 219 | ))
|
|---|
| 220 | (list "\\<[fd]?type\\>[ \t]*\\(\\sw+\\)" '(1 font-lock-type-face))
|
|---|
| 221 |
|
|---|
| 222 | ;; Fontify labeled labeled loop exits/goto targets.
|
|---|
| 223 | (list "\\<\\(break\\|continue\\|goto\\)\\>[ \t]*\\(-?\\sw+\\)?"
|
|---|
| 224 | '(1 font-lock-keyword-face)
|
|---|
| 225 | '(2 font-lock-constant-face nil t)
|
|---|
| 226 | )
|
|---|
| 227 |
|
|---|
| 228 | ;; Fontify case labels.
|
|---|
| 229 | '("\\<\\(case\\)\\>"
|
|---|
| 230 | (1 font-lock-keyword-face)
|
|---|
| 231 | ;("[ \t]*\\(-?\\sw+[ \t]*\\(\\(~\\)[ \t]*\\sw+\\)?\\)?"
|
|---|
| 232 | ("\\(-[0-9]+\\|\\sw+\\)+";\\([ \t]*~[ \t]*\\(-[0-9]+\\|\\sw+\\)\\)?\\)"
|
|---|
| 233 | ;; Return limit of search.
|
|---|
| 234 | (save-excursion (skip-chars-forward "^:\n") (point))
|
|---|
| 235 | nil
|
|---|
| 236 | (1 font-lock-constant-face nil t))
|
|---|
| 237 | ;'(2 font-lock-constant-face nil t)
|
|---|
| 238 | )
|
|---|
| 239 |
|
|---|
| 240 | ;; This must come after the one for keywords and targets. (named blocks)
|
|---|
| 241 | ;; xxx: gets 'default' and designated initializers
|
|---|
| 242 | ;; `(":" ( ,(concat "^\\([ \t]*\\(" CFA-valid-identifier "\\)[ \t]*:\\)+")
|
|---|
| 243 | ;; ,@(if (not (string= "default" (match-string 2)))
|
|---|
| 244 | ;; '((message "Check it out: (%s)" (match-data))
|
|---|
| 245 | ;; (error t)
|
|---|
| 246 | ;; (beginning-of-line) (end-of-line)
|
|---|
| 247 | ;; (2 font-lock-constant-face))
|
|---|
| 248 | ;; '((2 font-lock-keyword-face)))
|
|---|
| 249 | ;; ))
|
|---|
| 250 | `( ,(concat "^\\([ \t]*\\(" CFA-valid-identifier "\\)[ \t]*:\\)+")
|
|---|
| 251 | (2 font-lock-constant-face))
|
|---|
| 252 |
|
|---|
| 253 | ;; Fontify attributes
|
|---|
| 254 | (list "!\\<\\(\\sw+\\)\\>" '(1 font-lock-builtin-face))
|
|---|
| 255 |
|
|---|
| 256 | ;; Fontify some literals.
|
|---|
| 257 | ;'("\\<\\(false\\|true\\|null\\|undefined\\)\\>" . font-lock-constant-face)
|
|---|
| 258 | )))
|
|---|
| 259 |
|
|---|
| 260 | (setq CFA-font-lock-keywords-3
|
|---|
| 261 | (append CFA-font-lock-keywords-2
|
|---|
| 262 | ;;
|
|---|
| 263 | ;; More complicated regexps for more complete highlighting for types.
|
|---|
| 264 | ;; (Note: Need to revisit the styling here.)
|
|---|
| 265 | (list
|
|---|
| 266 | ;;
|
|---|
| 267 | ;; Fontify random types immediately followed by an item or items.
|
|---|
| 268 | `(eval .
|
|---|
| 269 | (list (concat "\\<\\(" (,@ CFA-type-names) "\\)\\>"
|
|---|
| 270 | "\\([ \t]*\\[[ \t]*\\]\\)*"
|
|---|
| 271 | "\\([ \t]*\\sw\\)")
|
|---|
| 272 | ;; Fontify each declaration item.
|
|---|
| 273 | (list 'font-lock-match-c++-style-declaration-item-and-skip-to-next
|
|---|
| 274 | ;; Start with point after all type specifiers.
|
|---|
| 275 | (list 'goto-char (list 'or
|
|---|
| 276 | (list 'match-beginning
|
|---|
| 277 | (+ (,@ CFA-type-names-depth) 2))
|
|---|
| 278 | '(match-end 1)))
|
|---|
| 279 | ;; Finish with point after first type specifier.
|
|---|
| 280 | '(goto-char (match-end 1))
|
|---|
| 281 | ;; Fontify as a variable or function name.
|
|---|
| 282 | '(1 (if (match-beginning 2)
|
|---|
| 283 | font-lock-function-name-face
|
|---|
| 284 | font-lock-variable-name-face))))))
|
|---|
| 285 |
|
|---|
| 286 | ))
|
|---|
| 287 | )
|
|---|
| 288 |
|
|---|
| 289 |
|
|---|
| 290 | (defvar CFA-font-lock-keywords CFA-font-lock-keywords-3
|
|---|
| 291 | "Default expressions to highlight in CFA mode.
|
|---|
| 292 | See also `CFA-font-lock-extra-types'.")
|
|---|
| 293 |
|
|---|
| 294 |
|
|---|
| 295 | ;; (defun print-point ()
|
|---|
| 296 | ;; (interactive)
|
|---|
| 297 | ;; (message "The point is: %d" (point)))
|
|---|
| 298 |
|
|---|
| 299 |
|
|---|
| 300 | (defun CFA-mode ()
|
|---|
| 301 | "Major mode for editing CForAll code.
|
|---|
| 302 | Key bindings:
|
|---|
| 303 | \\{CFA-mode-map}"
|
|---|
| 304 | (interactive)
|
|---|
| 305 | (c-initialize-cc-mode)
|
|---|
| 306 | (kill-all-local-variables)
|
|---|
| 307 | (set-syntax-table CFA-mode-syntax-table)
|
|---|
| 308 | (setq major-mode 'CFA-mode
|
|---|
| 309 | mode-name "CFA"
|
|---|
| 310 | local-abbrev-table CFA-mode-abbrev-table)
|
|---|
| 311 | (use-local-map CFA-mode-map)
|
|---|
| 312 | (c-common-init)
|
|---|
| 313 | (setq comment-start "// "
|
|---|
| 314 | comment-end ""
|
|---|
| 315 | c-conditional-key c-CFA-conditional-key
|
|---|
| 316 | c-comment-start-regexp c-CFA-comment-start-regexp
|
|---|
| 317 | c-class-key c-CFA-class-key
|
|---|
| 318 | c-extra-toplevel-key c-CFA-extra-toplevel-key
|
|---|
| 319 | ; c-method-key c-CFA-method-key
|
|---|
| 320 | c-baseclass-key nil
|
|---|
| 321 | c-recognize-knr-p nil
|
|---|
| 322 | c-access-key c-CFA-access-key
|
|---|
| 323 | c-inexpr-class-key nil
|
|---|
| 324 | )
|
|---|
| 325 |
|
|---|
| 326 | ;; Font lock
|
|---|
| 327 | (make-local-variable 'font-lock-defaults)
|
|---|
| 328 | (setq font-lock-defaults
|
|---|
| 329 | '((CFA-font-lock-keywords CFA-font-lock-keywords-1
|
|---|
| 330 | CFA-font-lock-keywords-2 CFA-font-lock-keywords-3)
|
|---|
| 331 | nil nil ((?_ . "w") (?$ . "w")) nil
|
|---|
| 332 | (font-lock-mark-block-function . mark-defun)))
|
|---|
| 333 |
|
|---|
| 334 | ; keybindings
|
|---|
| 335 | ;(local-set-key [C-f3] 'print-point)
|
|---|
| 336 |
|
|---|
| 337 | ;; hooks
|
|---|
| 338 | (run-hooks 'c-mode-common-hook)
|
|---|
| 339 | (run-hooks 'CFA-mode-hook)
|
|---|
| 340 | (c-update-modeline))
|
|---|
| 341 |
|
|---|
