code.delx.au - gnu-emacs-elpa/blob - packages/sm-c-mode/sm-c-mode.el

   1 ;;; sm-c-mode.el --- Experimental C major mode based on SMIE  -*- lexical-binding: t; -*-
   2
   3 ;; Copyright (C) 2015  Free Software Foundation, Inc.
   4
   5 ;; Author: Stefan Monnier <monnier@iro.umontreal.ca>
   6 ;; Version: 0
   7 ;; Keywords:
   8
   9 ;; This program is free software; you can redistribute it and/or modify
  10 ;; it under the terms of the GNU General Public License as published by
  11 ;; the Free Software Foundation, either version 3 of the License, or
  12 ;; (at your option) any later version.
  13
  14 ;; This program is distributed in the hope that it will be useful,
  15 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  16 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  17 ;; GNU General Public License for more details.
  18
  19 ;; You should have received a copy of the GNU General Public License
  20 ;; along with this program.  If not, see <http://www.gnu.org/licenses/>.
  21
  22 ;;; Commentary:
  23
  24 ;; ¡¡Don't use this!!
  25 ;;
  26 ;; This is an experiment to see concretely where&how SMIE falls down when
  27 ;; trying to handle a language like C.
  28 ;; So, strictly speaking, this does provide "SMIE-based indentation for C" and
  29 ;; might even do it OK for simple cases, but it really doesn't benefit much
  30 ;; from SMIE:
  31 ;; - it does a lot of its own parsing by hand.
  32 ;; - its smie-ruled-function also does a lot of indentation by hand.
  33 ;; Hopefully at some point, someone will find a way to extend SMIE such that
  34 ;; it can handle C without having to constantly work around SMIE, e.g.
  35 ;; it'd be nice to hook the sm-c--while-to-do, sm-c--else-to-if, and sm-c--boi
  36 ;; functions into SMIE at some level.
  37
  38 ;; FIXME:
  39 ;; - M-; mistakes # for a comment in CPP directives!
  40 ;; Ha!  As if this was the only/main problem!
  41
  42 ;;; Code:
  43
  44 (require 'cl-lib)
  45 (require 'smie)
  46
  47 (defgroup sm-c-mode nil
  48   "Major mode to edit C code, based on SMIE."
  49   :group 'programming)
  50
  51 (defcustom sm-c-indent-basic 2
  52   "Basic step of indentation.
  53 Typically 2 for GNU style and `tab-width' for Linux style."
  54   :type 'integer)
  55
  56 (defcustom sm-c-indent-braces t
  57   "If non-nil, braces in if/while/... are indented."
  58   :type 'boolean)
  59
  60 ;;; Handling CPP directives.
  61
  62 (defsubst sm-c--cpp-inside-p (ppss)
  63   (eq 2 (nth 7 ppss)))
  64
  65 (eval-and-compile
  66   (defconst sm-c--cpp-regexp "^[ \t]*\\(\\(#\\)[ \t]*\\([a-z]+\\)\\)"))
  67
  68 (defconst sm-c--cpp-syntax-table
  69   (let ((st (make-syntax-table)))
  70     (modify-syntax-entry ?/ ". 124" st)
  71     (modify-syntax-entry ?* ". 23b" st)
  72     (modify-syntax-entry ?\n ">" st)
  73     st))
  74
  75 (defun sm-c--cpp-goto-end (ppss &optional limit)
  76   (cl-assert (sm-c--cpp-inside-p ppss))
  77   (let (found)
  78     (while
  79         (and (setq found (re-search-forward "\\(?:\\\\\\\\\\)*\n" limit 'move))
  80              ;; We could also check (nth 5 ppss) to figure out if we're
  81              ;; after a backslash, but this is a very common case, so it's good
  82              ;; to avoid calling parse-partial-sexp for that.
  83              (or (eq ?\\ (char-before (match-beginning 0)))
  84                  (with-syntax-table sm-c--cpp-syntax-table
  85                    (nth 4 (parse-partial-sexp (1+ (nth 8 ppss)) (point)))))))
  86     found))
  87
  88 (defun sm-c--cpp-fontify-syntactically (ppss)
  89   ;; FIXME: ¡¡BIG UGLY HACK!!
  90   ;; Copied from font-lock.el's font-lock-fontify-syntactically-region.
  91   (cl-assert (> (point) (nth 8 ppss)))
  92   (save-excursion
  93     (save-restriction
  94       (sm-c--cpp-goto-end ppss)
  95       (narrow-to-region (1+ (nth 8 ppss)) (point))
  96       ;; FIXME: We should add some "with-local-syntax-ppss" macro to
  97       ;; encapsulate this.
  98       (let ((syntax-propertize-function nil)
  99             (syntax-ppss-cache nil)
 100             (syntax-ppss-last nil))
 101         (font-lock-fontify-syntactically-region (point-min) (point-max))))))
 102
 103 (defun sm-c--cpp-syntax-propertize (end)
 104   (let ((ppss (syntax-ppss))
 105         found)
 106     (when (sm-c--cpp-inside-p ppss)
 107       (while
 108           (and (setq found (re-search-forward "\\(\\\\\\\\\\)*\n" end 'move))
 109                (or (eq ?\\ (char-before (match-beginning 0)))
 110                    (with-syntax-table sm-c--cpp-syntax-table
 111                      (nth 4 (parse-partial-sexp (1+ (nth 8 ppss)) (point)))))))
 112       (when found
 113         (put-text-property (1- (point)) (point)
 114                            'syntax-table (string-to-syntax "> c"))))))
 115
 116 ;;;; Indenting CPP directives.
 117
 118 (defcustom sm-c-indent-cpp-basic 1
 119   "Indent step for CPP directives."
 120   :type 'integer)
 121
 122 (defun sm-c--cpp-prev (tok)
 123   (let ((offset nil))
 124     (while
 125         (when (re-search-backward sm-c--cpp-regexp nil t)
 126           (pcase (cons tok (match-string 3))
 127             (`(,_ . "endif") (sm-c--cpp-prev "endif"))
 128             ((or `(,(or "endif" "else" "elif") . ,(or "if" "ifdef" "ifndef"))
 129                  `(,(or "else" "elif") . "elif"))
 130              (setq offset 0))
 131             (`(,(or "endif" "else" "elif") . ,_) nil)
 132             (`(,_ . ,(or "if" "ifdef" "ifndef" "elif" "else"))
 133              (setq offset sm-c-indent-cpp-basic))
 134             (_ (setq offset 0)))
 135           (not offset)))
 136     (when offset
 137       (goto-char (match-beginning 3))
 138       (+ offset (current-column)))))
 139
 140
 141 (defun sm-c--cpp-indent-line (&optional _arg)
 142   ;; FIXME: Also align the terminating \, if any.
 143   (when (> sm-c-indent-cpp-basic 0)
 144     (let* ((pos (point-marker))
 145            (beg)
 146            (indent
 147             (save-excursion
 148               (forward-line 0)
 149               (when (looking-at sm-c--cpp-regexp)
 150                 (setq beg (match-beginning 3))
 151                 (or (sm-c--cpp-prev (match-string 3)) 0)))))
 152       (when indent
 153         (let ((before (<= pos beg)))
 154           (goto-char beg)
 155           (unless (= (current-column) indent)
 156             (skip-chars-backward " \t")
 157             (delete-region (point)
 158                            (progn (skip-chars-forward " \t") (point)))
 159             (indent-to indent))
 160           (unless before (goto-char pos)))))))
 161
 162 ;;;; Indenting inside CPP #define.
 163
 164 (defconst sm-c--cpp-smie-indent-functions
 165   ;; FIXME: Don't just align line after #define with the "d"!
 166   (mapcar
 167    (lambda (f)
 168      (cond
 169       ((eq f #'smie-indent-comment-inside) #'sm-c--cpp-indent-comment-inside)
 170       ;; ((eq f #'smie-indent-exps) #'sm-c--cpp-indent-exps)
 171       (t f)))
 172    (default-value 'smie-indent-functions)))
 173
 174 (defun sm-c--cpp-indent-comment-inside ()
 175   (let ((ppss (syntax-ppss)))
 176     (when (nth 4 ppss)
 177       ;; Indicate where's the comment start.
 178       `(noindent . ,(nth 8 ppss)))))
 179
 180 (defun sm-c--cpp-smie-indent ()
 181   (let ((ppss (syntax-ppss)))
 182     (cond
 183      ((sm-c--cpp-inside-p ppss)
 184       (save-restriction
 185         (narrow-to-region (nth 8 ppss) (point-max))
 186         (let ((indent
 187                (let ((smie-indent-functions sm-c--cpp-smie-indent-functions)
 188                      (syntax-ppss-cache nil)
 189                      (syntax-ppss-last nil)
 190                      (parse-sexp-lookup-properties nil))
 191                  (smie-indent-calculate))))
 192           (if (not (eq 'noindent (car-safe indent)))
 193               (if (integerp indent)
 194                   (max (funcall smie-rules-function :elem 'basic) indent)
 195                 indent)
 196             ;; We can't just return `noindent' if we're inside a comment,
 197             ;; because the indent.el code would then be similarly confused,
 198             ;; thinking the `noindent' is because we're inside the cpp
 199             ;; pseudo-comment, and would hence align the code with the content
 200             ;; of the psuedo-comment rather than the nested real comment!
 201             ;;
 202             ;; FIXME: Copy&paste from indent--default-inside-comment.
 203             ;; FIXME: This will always re-indent inside these comments, even
 204             ;; during indent-region.
 205             (save-excursion
 206               (forward-line -1)
 207               (skip-chars-forward " \t")
 208               (when (< (1- (point)) (cdr indent) (line-end-position))
 209                 (goto-char (cdr indent))
 210                 (when (looking-at comment-start-skip)
 211                   (goto-char (match-end 0))))
 212               (current-column))))))
 213
 214      ((equal (syntax-after (point)) (string-to-syntax "< c")) 0)
 215      )))
 216
 217 ;;; Syntax table
 218
 219 (defvar sm-c-mode-syntax-table
 220   (let ((st (make-syntax-table)))
 221     (modify-syntax-entry ?/ ". 124" st)
 222     (modify-syntax-entry ?* ". 23b" st)
 223     (modify-syntax-entry ?\n ">" st)
 224     (modify-syntax-entry ?\" "\"" st)
 225     (modify-syntax-entry ?\' "\"" st)
 226     (modify-syntax-entry ?= "." st)
 227     (modify-syntax-entry ?< "." st)
 228     (modify-syntax-entry ?> "." st)
 229     st))
 230
 231 (defun sm-c-syntax-propertize (start end)
 232   (goto-char start)
 233   (sm-c--cpp-syntax-propertize end)
 234   (funcall
 235    (syntax-propertize-rules
 236     (sm-c--cpp-regexp (2 (prog1 "< c" (sm-c--cpp-syntax-propertize end)))))
 237    (point) end))
 238
 239 (defun sm-c-syntactic-face-function (ppss)
 240   (if (sm-c--cpp-inside-p ppss)
 241       (prog1 nil (sm-c--cpp-fontify-syntactically ppss))
 242     (funcall (default-value 'font-lock-syntactic-face-function) ppss)))
 243
 244 ;;; SMIE support
 245
 246 (defconst sm-c-paren-block-keywords '("if" "while" "for" "switch"))
 247
 248 (defconst sm-c-smie-precedence-table
 249   '((assoc ";")
 250     ;; Compiled from https://en.wikipedia.org/wiki/Operators_in_C_and_C++.
 251     (assoc ",")                         ;1
 252     ;; (nonassoc "throw")
 253     (nonassoc "=" "+=" "-=" "*=" "/=" "%=" "<<=" ">>=" "&=" "^=" "|=") ;2
 254     ;; (nonassoc "?" ":") ;; Better handle it in the BNF.
 255     (assoc "||")                        ;3
 256     (assoc "&&")                        ;4
 257     (assoc "|")                         ;5
 258     (assoc "^")                         ;6
 259     ;; (assoc "&") ;; Binary and.  Confused with address-of.
 260     (nonassoc "==" "!=")                ;7
 261     (nonassoc "<" "<=" ">" ">=")        ;8
 262     (nonassoc "<<" ">>")                ;9
 263     (assoc "+" "-")                     ;10
 264     (assoc "/" "* mult" "%")            ;11
 265     ;; (nonassoc ".*" "->*")            ;12   ;; Only C++
 266     ;; (nonassoc "++" "--" "+" "-" "!" "~" "(type)" "*" "&"
 267     ;;          "sizeof" "new" "delete");13  ;; All prefix.
 268     (left "." "->") ;; "++" "--" suffixes, "()", "[]", "typeid", "*_cast". ;14
 269     ;; (noassoc "::") ;; Only C++
 270     ))
 271
 272 (defconst sm-c-smie-grammar
 273   ;; `((:smie-closer-alist ("{" . "}")) ("{" (39) 0) ("}" 0 (40)) ("else" 27 26) ("," 38 38) ("do" (41) 22) ("while" (42) 23) ("for" (43) 24) (";" 11 11) ("if" (44) 25))
 274   (let ((grm
 275          (smie-prec2->grammar
 276           (smie-merge-prec2s
 277            (smie-bnf->prec2
 278             '((decls ("typedef" decl) ("extern" decl)
 279                      (decls ";" decls))
 280               (decl)
 281               (id)
 282               (insts ("{" insts "}")
 283                      (insts ";" insts)
 284                      ("return" exp)
 285                      ("goto" exp)
 286                      (":label")
 287                      ("case" subexp ": case")
 288                      ("else" exp-if))
 289               (exp-if ("if" exp) ("do" exp) ("while" exp) ("switch" exp) ("for" exp)
 290                       (exp))
 291               (exp ("(" exp ")") (exp "," exp) (subexp "?" exp ":" exp))
 292               (subexp (subexp "||" subexp))
 293               ;; Some of the precedence table deals with pre/postfixes, which
 294               ;; smie-precs->prec2 can't handle, so handle it here instead.
 295               (exp11 (exp12) (exp11 "/" exp11))
 296               (exp12 (exp13))           ;C++ only.
 297               (exp13 (exp14) ("++ prefix" exp13) ("-- prefix" exp13)
 298                      ("!" exp13) ("~" exp13) ("&" exp13) ("* deref" exp13))
 299               (exp14 (id) (exp14 "++ postfix") (exp14 "-- postfix")
 300                      (exp14 "->" id) (exp14 "." id)))
 301             '((assoc ";") (assoc ",") (nonassoc "?" ":"))
 302             sm-c-smie-precedence-table)
 303            (smie-precs->prec2 sm-c-smie-precedence-table)
 304            (smie-precs->prec2 '((nonassoc ";") (nonassoc ":")))))))
 305     ;; SMIE gives (":label" 261 262), but really this could just as well be
 306     ;; (":label" nil nil) because labels don't have any argument to their left
 307     ;; or right.  They're like both openers and closers at the same time.
 308     (mapcar (lambda (x)
 309               (if (equal (car-safe x) ":label")
 310                   ;; Rather than (":label" (n1) (n2)) we use
 311                   ;; (":label" (n1) n2) because SMIE otherwise complains:
 312                   ;; cl--assertion-failed((numberp (funcall op-forw toklevels)))
 313                   ;; in smie-next-sexp.
 314                   `(,(nth 0 x) (,(nth 1 x)) ,(nth 2 x)) x))
 315             grm)))
 316
 317 ;; (defun sm-c--:-discriminate ()
 318 ;;   (save-excursion
 319 ;;     (and (null (smie-backward-sexp))
 320 ;;          (let ((prev (smie-indent-backward-token)))
 321 ;;            (cond
 322 ;;             ((equal prev "case" ) ": case")
 323 ;;             ((member prev '(";" "{" "}")) ":-label")
 324 ;;             (t ":"))))))
 325
 326 (defconst sm-c-smie-operator-regexp
 327   (let ((ops '()))
 328     (pcase-dolist (`(,token . ,_) sm-c-smie-grammar)
 329       (when (and (stringp token) (string-match "\\`[^ [:alnum:](){}]+" token))
 330         (push (match-string 0 token) ops)))
 331     (regexp-opt ops)))
 332
 333 (defun sm-c-smie-forward-token ()
 334   (forward-comment (point-max))
 335   (let ((tok (if (looking-at sm-c-smie-operator-regexp)
 336                  (progn (goto-char (match-end 0)) (match-string 0))
 337                (smie-default-forward-token))))
 338     (cond
 339      ((and (equal tok "") (looking-at "\\\\\n"))
 340       (goto-char (match-end 0))
 341       (sm-c-smie-forward-token))
 342      ((member tok '(":" "*"))
 343       (save-excursion (sm-c-smie-backward-token)))
 344      ((looking-at "[ \t]*:")
 345       (if (not (equal (save-excursion (sm-c-smie-forward-token)) ":label"))
 346           tok
 347         (looking-at "[ \t]*:")
 348         (goto-char (match-end 0)) ":label"))
 349      (t tok))))
 350
 351
 352 (defun sm-c-smie-backward-token ()
 353   (forward-comment (- (point)))
 354   (let ((tok (if (looking-back sm-c-smie-operator-regexp (- (point) 3) t)
 355                  (progn (goto-char (match-beginning 0)) (match-string 0))
 356                (smie-default-backward-token))))
 357     (cond
 358      ((and (equal tok "") (looking-at "\n"))
 359       (let ((pos (point)))
 360         (if (not (= 0 (mod (skip-chars-backward "\\\\") 2)))
 361             (sm-c-smie-backward-token)
 362           (goto-char pos)
 363           tok)))
 364      ((equal tok "*") (sm-c-smie--*-token))
 365      ((equal tok ":")
 366       (let ((pos1 (point))
 367             (prev (sm-c-smie-backward-token)))
 368         (if (zerop (length prev))
 369             (progn (goto-char pos1) tok)
 370           (let ((pos2 (point)))
 371             (pcase (car (smie-indent-backward-token))
 372               ("case" (goto-char pos1) ": case")
 373               ((or ";" "{" "}") (goto-char pos2) ":label")
 374               (_ (goto-char pos1) tok))))))
 375      (t tok))))
 376
 377 (defun sm-c--prev-token ()
 378   (car (smie-indent-backward-token)))
 379
 380 (defun sm-c--else-to-if ()
 381   (let ((pos (point)))
 382     (unless (equal (sm-c--prev-token) ";")
 383       (goto-char pos))
 384     (while
 385         (pcase (smie-backward-sexp)
 386           (`(,_ ,pos "if") (goto-char pos) nil) ;Found it!
 387           (`(,_ ,_ ";") nil)                    ;Can't find it!
 388           (`(,_ ,pos "else") (goto-char pos) (sm-c--else-to-if) t)
 389           (`(,_ ,pos "while")
 390            (goto-char pos) (unless (sm-c--while-to-do) (goto-char pos)) t)
 391           (`(t . ,_) nil)               ;Can't find it!
 392           (`(,_ ,pos . ,_) (goto-char pos) t)
 393           (`nil t)))))
 394
 395 (defun sm-c--while-to-do ()
 396   "Jump to the matching `do' and return non-nil, if any.  Return nil otherwise."
 397   (pcase (sm-c--prev-token)
 398     ("}"
 399      ;; The easy case!
 400      (forward-char 1) (backward-sexp 1)
 401      (equal (sm-c--prev-token) "do"))
 402     (";"
 403      (let ((found-do nil))
 404        (while
 405            (pcase (smie-backward-sexp)
 406              (`(,_ ,pos "do") (goto-char pos) (setq found-do t) nil)
 407              (`(,_ ,_ ";") nil)         ;Can't find it!
 408              (`(,_ ,pos "else") (goto-char pos) (sm-c--else-to-if) t)
 409              (`(,_ ,pos "while")
 410               (goto-char pos) (unless (sm-c--while-to-do) (goto-char pos)) t)
 411              (`(t . ,_) nil)            ;Can't find it!
 412              (`(,_ ,pos . ,_) (goto-char pos) t)
 413              (`nil (or (not (looking-at "{"))
 414                        (smie-rule-prev-p "=")))))
 415        found-do))))
 416
 417 (defun sm-c--skip-labels (max)
 418   (while
 419       (let ((start (point)))
 420         (pcase (sm-c-smie-forward-token)
 421           ("case"
 422            (smie-forward-sexp "case")
 423            (forward-comment (point-max))
 424            (if (>= (point) max) (progn (goto-char start) nil)
 425              t))
 426           (":label"
 427            (forward-comment (point-max))
 428            (if (>= (point) max) (progn (goto-char start) nil)
 429              t))
 430           (_ (goto-char start) nil)))))
 431
 432 (defun sm-c--boi (&optional inner)
 433   "Jump to the beginning-of-instruction.
 434 By default for things like nested ifs, it jumps to the outer if, but
 435 if INNER is non-nil, it stops at the innermost one."
 436   (while
 437       (let ((pos (point)))
 438         (pcase (smie-backward-sexp)
 439           (`(,_ ,_ ";") nil)            ;Found it!
 440           (`(,_ ,pos "else") (goto-char pos) (sm-c--else-to-if) t)
 441           (`(,_ ,pos "while")
 442            (goto-char pos) (unless (sm-c--while-to-do) (goto-char pos)) t)
 443           (`(,(pred numberp) ,pos . ,_) (goto-char pos) t)
 444           ((or `nil `(nil . ,_))
 445            (if (and (or (not (looking-at "{"))
 446                         (smie-rule-prev-p "="))
 447                     (not (bobp)))
 448                t
 449              (goto-char pos) nil))
 450           (`(,_ ,_ ,(or "(" "{" "[")) nil) ;Found it!
 451           (`(,_ ,pos ,(and tok
 452                            (guard (when inner
 453                                     (or (member tok sm-c-paren-block-keywords)
 454                                         (equal tok "do"))))))
 455            (goto-char pos) nil) ;Found it!
 456           (`(t ,(pred (eq (point-min))) . ,_) nil)
 457           (`(,_ ,pos . ,_) (goto-char pos) t)))))
 458
 459 ;; (defun sm-c--if-tail-to-head ()
 460 ;;   (pcase (sm-c--prev-token)
 461 ;;     (")"
 462 ;;      (forward-char 1) (backward-sexp 1)
 463 ;;      (pcase (sm-c--prev-token)
 464 ;;        ("if" nil)
 465 ;;        ((or "while" "for") (sm-c--if-tail-to-head))))
 466 ;;     ("do" (sm-c--if-tail-to-head))))
 467
 468 (defun sm-c--boe (tok)
 469   (let ((start (point))
 470         (res (smie-backward-sexp tok)))
 471     (when (member (nth 2 res) '("if" "while" "do" "for" "else"))
 472       (when (member (nth 2 res) '("if" "for"))
 473         (let ((forward-sexp-function nil))
 474           (forward-sexp 1))
 475         (forward-comment (point-max)))
 476       (when (looking-at "{")
 477         (let ((forward-sexp-function nil))
 478           (forward-sexp 1))
 479         (forward-comment (point-max)))
 480       (if (> (point) start) (goto-char start)))))
 481
 482 (defun sm-c-smie--*-token ()
 483   (save-excursion
 484     (let ((pos (point)))
 485       (pcase (car (smie-indent-backward-token))
 486         (")"
 487          ;; Can be a multiplication (as in "(a+b)*c"), or a deref
 488          ;; (as in "if (stop) *a = 0;")
 489          (if (and (goto-char (nth 1 (syntax-ppss)))
 490                   (eq ?\( (char-after))
 491                   (member (smie-default-backward-token) '("if" "for")))
 492              "* deref"
 493            "* mult"))
 494         ("]" "* mult")                         ;Multiplication.
 495         ((or "(" "[" "{" "}") "* deref")
 496         (`nil
 497          (goto-char pos)
 498          (pcase (smie-backward-sexp "* mult")
 499            (`(,_ ,_ ,(or ";" "{")) "* deref")
 500            (_ "* mult")))
 501         (_ "* mult")))))
 502
 503 (defun sm-c-smie-hanging-eolp ()
 504   (let ((start (point))
 505         (prev (smie-indent-backward-token)))
 506     (if (and (not (numberp (nth 1 prev)))
 507              (save-excursion (equal (sm-c-smie-backward-token) ";")))
 508         ;; Treat instructions that start after ";" as always "hanging".
 509         (end-of-line)
 510       (goto-char start)))
 511   (skip-chars-forward " \t")
 512   (or (eolp)
 513       (forward-comment (point-max))
 514       (and (looking-at "\\\\\n")
 515            (goto-char (match-end 0)))))
 516
 517 (defvar sm-c-smie--inhibit-case/label-rule nil)
 518
 519 (defun sm-c--smie-virtual ()
 520   (if (and (smie-indent--bolp)
 521            (not (save-excursion
 522                   (member (sm-c-smie-forward-token)
 523                           '("case" ":label")))))
 524       (current-column)
 525     (let ((sm-c-smie--inhibit-case/label-rule t))
 526       (smie-indent-calculate))))
 527
 528 (defun sm-c-smie-rules (kind token)
 529   (pcase (cons kind token)
 530     (`(:elem . basic) sm-c-indent-basic)
 531     (`(:list-intro . ";")
 532      (save-excursion
 533        (forward-char 1)
 534        (if (and (null (smie-forward-sexp))
 535                 ;; FIXME: Handle \\\n as well!
 536                 (progn (forward-comment (point-max))
 537                        (looking-at "(")))
 538            nil
 539          t)))
 540     (`(:before . "else")
 541      (save-excursion
 542        (sm-c--else-to-if)
 543        `(column . ,(smie-indent-virtual))))
 544     (`(:before . "while")
 545      (save-excursion
 546        (when (sm-c--while-to-do)
 547          `(column . ,(smie-indent-virtual)))))
 548     (`(:before . ,(or "=" "+=" "-=" "*=" "/=" "%=" "<<=" ">>=" "&=" "^=" "|="))
 549      (save-excursion
 550        (sm-c--boe token)
 551        `(column . ,(+ (funcall smie-rules-function :elem 'basic)
 552                       (smie-indent-virtual)))))
 553     (`(:before . "if")
 554      (when (and (not (smie-rule-bolp)) (smie-rule-prev-p "else"))
 555        (save-excursion
 556          (smie-indent-backward-token)
 557          `(column . ,(sm-c--smie-virtual)))))
 558     ;; (`(:after . ,(or "=" "+=" "-=" "*=" "/=" "%=" "<<=" ">>=" "&=" "^=" "|="))
 559     ;;  (funcall smie-rules-function :elem 'basic))
 560     (`(:before . "{")
 561      (cond
 562       ((smie-rule-prev-p "=") nil)      ;Not a block of instructions!
 563       ((save-excursion
 564          (let ((pos (point)))
 565            (sm-c--boi 'inner) (sm-c--skip-labels (point-max))
 566            (let ((tok (save-excursion (sm-c-smie-forward-token))))
 567              (cond
 568               ((member tok '("typedef")) ; "enum" "struct"
 569                `(column . ,(+ (funcall smie-rules-function :elem 'basic)
 570                               (smie-indent-virtual))))
 571               ((or (member tok sm-c-paren-block-keywords)
 572                    (equal tok "do"))
 573                nil)
 574               ((save-excursion
 575                  (goto-char pos)
 576                  (when (and (> (car (syntax-ppss)) 0)
 577                             (equal ")" (car (smie-indent-backward-token))))
 578                    (up-list -1)
 579                    `(column . ,(sm-c--smie-virtual)))))
 580               (t `(column . ,(smie-indent-virtual))))))))
 581       ((smie-rule-hanging-p)
 582        (cond
 583         ((smie-rule-prev-p "do" "else")
 584          (smie-indent-backward-token))
 585         ((smie-rule-prev-p ")")
 586          (smie-backward-sexp)
 587          (smie-indent-backward-token))
 588         (t (sm-c--boi 'inner)))
 589        `(column . ,(sm-c--smie-virtual)))
 590       (t
 591        (let ((pos (point)))
 592          (pcase (sm-c--prev-token)
 593            ((or "do" "else")
 594             (cond
 595              (sm-c-indent-braces
 596               `(column . ,(+ (funcall smie-rules-function :elem 'basic)
 597                              (smie-indent-virtual))))))
 598            (")" nil)
 599            (_ (goto-char pos) (sm-c--boi)
 600               (if (< (point) pos)
 601                   `(column . ,(sm-c--smie-virtual)))))))))
 602     (`(:before . "(")
 603      (save-excursion
 604        (let ((res (smie-backward-sexp)))
 605          (pcase res
 606            (`nil
 607             (if (looking-at "(")
 608                 ;; (unless (save-excursion
 609                 ;;           (member (sm-c-smie-backward-token)
 610                 ;;                   sm-c-paren-block-keywords))
 611                 ;;   `(column . ,(sm-c--smie-virtual)))
 612                 nil
 613               `(column . ,(+ (funcall smie-rules-function :elem 'basic)
 614                              (sm-c--smie-virtual)))))))))
 615     (`(:after . "else")
 616      (save-excursion
 617        (funcall smie-rules-function :elem 'basic)))
 618     (`(:after . ")")
 619      (save-excursion
 620        (let ((_ (progn (forward-char 1) (backward-sexp 1)))
 621              (pos (point))
 622              (prev (sm-c-smie-backward-token)))
 623          (cond
 624           ((member prev sm-c-paren-block-keywords)
 625            `(column . ,(+ (funcall smie-rules-function :elem 'basic)
 626                           (smie-indent-virtual))))
 627           ((and (looking-at "[[:alnum:]_]+(")
 628                 (save-excursion
 629                   (forward-line 0)
 630                   (and (bobp) (looking-at sm-c--cpp-regexp))))
 631            ;; Will be bumped up presumably by the "max" in
 632            ;; sm-c--cpp-smie-indent.
 633            `(column . 0))
 634           (t (goto-char pos) `(column . ,(sm-c--smie-virtual)))))))
 635     (`(:after . "}")
 636      (save-excursion
 637        (forward-char 1) (backward-sexp 1)
 638        (sm-c--boi)
 639        `(column . ,(sm-c--smie-virtual))))
 640     (`(:after . ";")
 641      (save-excursion
 642        (sm-c--boi)
 643        `(column . ,(sm-c--smie-virtual))))
 644     (`(:after . ":label")
 645      ;; Yuck!
 646      `(column . ,(sm-c--smie-virtual)))
 647     (`(:after . ": case")
 648      ;; Yuck!
 649      (save-excursion
 650        (smie-backward-sexp ": case")
 651        `(column . ,(sm-c--smie-virtual))))
 652     (`(:after . "* deref") `(column . ,(sm-c--smie-virtual)))
 653     ((and `(:before . ":label") (guard (not sm-c-smie--inhibit-case/label-rule)))
 654      (let ((ppss (syntax-ppss)))
 655        (when (nth 1 ppss)
 656          (save-excursion
 657            (goto-char (nth 1 ppss))
 658            `(column . ,(smie-indent-virtual))))))
 659     ((and `(:before . "case") (guard (not sm-c-smie--inhibit-case/label-rule)))
 660      (catch 'found
 661        (dolist (pos (reverse (nth 9 (syntax-ppss))))
 662          (save-excursion
 663            (goto-char pos)
 664            (and (looking-at "{")
 665                 (null (car-safe (smie-backward-sexp)))
 666                 (equal "switch" (sm-c-smie-backward-token))
 667                 (goto-char pos)
 668                 (throw 'found `(column . ,(smie-indent-virtual))))))))))
 669
 670 ;;; Backslash alignment
 671
 672 (defvar-local sm-c--bs-changed nil)
 673
 674 (defun sm-c--bs-after-change (beg end _len)
 675   (unless undo-in-progress
 676     (if (null sm-c--bs-changed)
 677         (setq sm-c--bs-changed (cons beg end))
 678       (cl-callf (lambda (x) (min x beg)) (car sm-c--bs-changed))
 679       (cl-callf (lambda (x) (max x end)) (cdr sm-c--bs-changed)))))
 680
 681 (defun sm-c--bs-realign ()
 682   (when sm-c--bs-changed
 683     (sm-c--bs-realign-1 (car sm-c--bs-changed) (cdr sm-c--bs-changed))
 684     (setq sm-c--bs-changed nil)))
 685
 686 (defun sm-c--bs-realign-1 (from to)
 687   (save-excursion
 688     (goto-char from)
 689     (end-of-line)
 690     (unless (zerop (mod (skip-chars-backward "\\\\") 2))
 691       (skip-chars-backward " \t")
 692       (let ((col (current-column))
 693             start end)
 694         (while
 695             (progn (setq start (point))
 696                    (end-of-line 0)
 697                    (and (< (point) start)
 698                         (not (zerop (mod (skip-chars-backward "\\\\") 2)))))
 699           (skip-chars-backward " \t")
 700           (setq col (max (current-column) col)))
 701         (goto-char from)
 702         (while
 703             (progn (setq end (point))
 704                    (end-of-line 2)
 705                    (and (> (point) start)
 706                         (not (zerop (mod (skip-chars-backward "\\\\") 2)))))
 707           (skip-chars-backward " \t")
 708           (setq col (max (current-column) col)))
 709         (goto-char to)
 710         (beginning-of-line)
 711         (unless (or (> (point) end)       ;Don't realign if we changed outside!
 712                     (< end start))        ;A lone \
 713
 714           (setq col (1+ col))         ;Add a space before the backslashes.
 715           (goto-char end)
 716           (end-of-line)
 717           (while (>= (point) start)
 718             (cl-assert (eq (char-before) ?\\))
 719             (forward-char -1)
 720             (let ((curcol (current-column)))
 721               (cond
 722                ((> col curcol) (indent-to col))
 723                ((< col curcol)
 724                 (move-to-column col t)
 725                 (delete-region (point)
 726                                (progn (skip-chars-forward " \t") (point))))))
 727             (end-of-line 0)))))))
 728
 729 ;;; Font-lock support
 730
 731 (defconst sm-c-font-lock-keywords
 732   `((,sm-c--cpp-regexp (1 font-lock-preprocessor-face))
 733     ("\\_<\\(?:true\\|false\\)\\_>" (0 font-lock-constant-face))
 734     ("\\_<\\(case\\)\\_>[ \t]*\\([^: \t]+\\)"
 735      (1 font-lock-keyword-face)
 736      (2 font-lock-constant-face))
 737     ("\\(?:[{};]\\(\\)\\|^\\)[ \t]*\\([[:alpha:]_][[:alnum:]_]*\\)[ \t]*:"
 738      (2 (if (or (match-beginning 1)
 739                 (save-excursion (equal ":label" (sm-c-smie-backward-token))))
 740             font-lock-constant-face)))
 741     (,(let ((kws (delq nil (mapcar (lambda (x)
 742                                      (setq x (car x))
 743                                      (and (stringp x)
 744                                           (string-match "\\`[a-z]" x)
 745                                           x))
 746                                    sm-c-smie-grammar))))
 747         (concat "\\_<" (regexp-opt
 748                         (append
 749                          ;; Elements not in SMIE's grammar.  Either because
 750                          ;; they're uninteresting from a parsing point of view,
 751                          ;; or because SMIE's parsing engine can't handle them
 752                          ;; even poorly.
 753                          '("break" "continue" "struct" "enum" "union" "static")
 754                          ;; "case" already handled above.
 755                          (delete "case" kws)))
 756                 "\\_>"))
 757      (0 font-lock-keyword-face))
 758     (,(let* ((spc0 "\\(?:\n?[ \t]\\|/\\*.*?\\*/\\)*")
 759              (spc1 (concat "\n?[ \t]" spc0))
 760              (id "\\(?:\\sw\\|\\s_\\)+"))
 761         (cl-flet ((repeat (repetition &rest res)
 762                           (concat "\\(?:" (apply #'concat res) "\\)"
 763                                   (pcase repetition
 764                                     ((pred symbolp) (symbol-name repetition))
 765                                     (1 "")))))
 766           (concat
 767            "^"
 768            (repeat '* "\\*" spc0)
 769            (repeat '* id (repeat 1 spc1 "\\|" spc0 "\\*" spc0))
 770            "\\(" id "\\)[ \t\n]*(")))
 771      (1
 772       (prog1 font-lock-function-name-face
 773         (if (< (match-beginning 0) (line-beginning-position))
 774             (put-text-property (match-beginning 0) (match-end 0)
 775                                'font-lock-multiline t)))))))
 776
 777
 778 ;;;###autoload
 779 (define-derived-mode sm-c-mode prog-mode "smC"
 780   "C editing mode based on SMIE."
 781   ;; (setq-local font-lock-support-mode nil) ;; To help debugging.
 782   (setq-local comment-start "/* ")
 783   (setq-local comment-end " */")
 784   (setq-local parse-sexp-lookup-properties t)
 785   (setq-local open-paren-in-column-0-is-defun-start nil)
 786   (setq-local syntax-propertize-function #'sm-c-syntax-propertize)
 787   (setq-local font-lock-defaults '(sm-c-font-lock-keywords))
 788   (setq-local font-lock-syntactic-face-function #'sm-c-syntactic-face-function)
 789   (smie-setup sm-c-smie-grammar #'sm-c-smie-rules
 790               :backward-token #'sm-c-smie-backward-token
 791               :forward-token #'sm-c-smie-forward-token)
 792   ;; FIXME: The stock SMIE forward-sexp-function is not good enough here, since
 793   ;; our grammar is much too poor.  We should setup another function instead
 794   ;; (or ideally teach SMIE to use it).
 795   (kill-local-variable 'forward-sexp-function)
 796   (add-hook 'smie-indent-functions #'sm-c--cpp-smie-indent nil t)
 797   (add-function :after (local 'indent-line-function)
 798                 #'sm-c--cpp-indent-line)
 799   (setq-local smie--hanging-eolp-function #'sm-c-smie-hanging-eolp)
 800   ;; Backslash auto-realign.
 801   (add-hook 'after-change-functions #'sm-c--bs-after-change nil t)
 802   (add-hook 'post-command-hook #'sm-c--bs-realign nil t))
 803
 804 (provide 'sm-c-mode)
 805 ;;; sm-c-mode.el ends here