| 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 | |
|---|
