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-rules-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 sm-c--while-to-do, sm-c--else-to-if, sm-c--boi,
  36 ;; sm-c--boe, ... into SMIE at some level.
  37
  38 ;; Note that this mode makes no attempt to try and handle sanely K&R style
  39 ;; function definitions.
  40
  41 ;;;; Benchmarks
  42
  43 ;; This code can't be compared to CC-mode since its scope is much more limited
  44 ;; (only tries to handle the kind of code found in Emacs's source code, for
  45 ;; example; does not intend to be extensible to handle C++ or ObjC; does not
  46 ;; offer the same kind of customizability of indentation style, ...).
  47 ;; But in order to make sure it's doing a good enough job on the code for which
  48 ;; it was tuned, I did run some quick benchmarks against CC-mode:
  49 ;;
  50 ;; Benchmarks: reindent emacs/src/*.[ch] (skipping macuvs.h and globals.h
  51 ;; because CC-mode gets pathologically slow on them).
  52 ;;    (cd src/emacs/work/; git reset --hard; mv src/macuvs.h src/globals.h ./);
  53 ;;    files=($(echo ~/src/emacs/work/src/*.[ch]));
  54 ;;    (cd src/emacs/work/; mv macuvs.h globals.h src/);
  55 ;;    time make -j4 ${^${files}}.reindent EMACS="emacs24 -Q";
  56 ;;    (cd src/emacs/work/; git diff|wc)
  57 ;; - Default settings:
  58 ;;   diff|wc =>  86800  379362 2879534
  59 ;;   make -j4  191.57s user 1.77s system 334% cpu   57.78 total
  60 ;; - With (setq sm-c-indent-cpp-basic 0)
  61 ;;   diff|wc =>  59909  275415 2034045
  62 ;;   make -j4  177.88s user 1.70s system 340% cpu   52.80 total
  63 ;; - For reference, CC-mode gets:
  64 ;;   diff|wc =>  79164  490894 3428542
  65 ;;   make -j4  804.83s user 2.79s system 277% cpu 4:51.08 total
  66 ;;
  67 ;; Again: take this with a large grain of salt, since this is testing sm-c-mode
  68 ;; in the most favorable light (IOW it's a very strongly biased benchmark).
  69 ;; All this says, is that sm-c-mode's indentation might actually be usable if
  70 ;; you use it on C code that is sufficiently similar to Emacs's.
  71
  72 ;;;; FIXME:
  73
  74 ;; - We "use but don't use" SMIE.
  75 ;; - CPP directives are treated as comments.  To some extent this is OK, but in
  76 ;;   many other cases it isn't.  See for instance the comment-only-p advice.
  77 ;; - M-q in a comment doesn't do the right thing.
  78
  79 ;;; Code:
  80
  81 (require 'cl-lib)
  82 (require 'smie)
  83
  84 (defgroup sm-c-mode nil
  85   "Major mode to edit C code, based on SMIE."
  86   :group 'programming)
  87
  88 (defcustom sm-c-indent-basic 2
  89   "Basic step of indentation.
  90 Typically 2 for GNU style and `tab-width' for Linux style."
  91   :type 'integer)
  92
  93 (defcustom sm-c-indent-braces t
  94   "If nil, braces in if/while/... are aligned with the if/while/...
  95 Else, they're indented by `sm-c-indent-basic' columns.
  96 For braces placed at the end of lines (which SMIE calls \"hanging\"), it makes
  97 no difference."
  98   :type 'boolean)
  99
 100 ;;; Handling CPP directives.
 101
 102 (defsubst sm-c--cpp-inside-p (ppss)
 103   (eq 2 (nth 7 ppss)))
 104
 105 (eval-and-compile
 106   (defconst sm-c--cpp-regexp "^[ \t]*\\(\\(#\\)[ \t]*\\([a-z]+\\)\\)"))
 107
 108 (defconst sm-c--cpp-syntax-table
 109   (let ((st (make-syntax-table)))
 110     (modify-syntax-entry ?/ ". 124" st)
 111     (modify-syntax-entry ?* ". 23b" st)
 112     (modify-syntax-entry ?\n ">" st)
 113     st))
 114
 115 (defun sm-c--cpp-goto-end (ppss &optional limit)
 116   (cl-assert (sm-c--cpp-inside-p ppss))
 117   (let (found)
 118     (while
 119         (and (setq found (re-search-forward "\\(?:\\\\\\\\\\)*\n" limit 'move))
 120              ;; We could also check (nth 5 ppss) to figure out if we're
 121              ;; after a backslash, but this is a very common case, so it's good
 122              ;; to avoid calling parse-partial-sexp for that.
 123              (or (eq ?\\ (char-before (match-beginning 0)))
 124                  (with-syntax-table sm-c--cpp-syntax-table
 125                    (nth 4 (parse-partial-sexp (1+ (nth 8 ppss)) (point)))))))
 126     found))
 127
 128 (defun sm-c--cpp-fontify-syntactically (ppss)
 129   ;; FIXME: ¡¡BIG UGLY HACK!!
 130   ;; Copied from font-lock.el's font-lock-fontify-syntactically-region.
 131   (cl-assert (> (point) (nth 8 ppss)))
 132   (save-excursion
 133     (save-restriction
 134       (sm-c--cpp-goto-end ppss)
 135       (narrow-to-region (1+ (nth 8 ppss)) (point))
 136       ;; FIXME: We should add some "with-local-syntax-ppss" macro to
 137       ;; encapsulate this.
 138       (let ((syntax-propertize-function nil)
 139             (syntax-ppss-cache nil)
 140             (syntax-ppss-last nil))
 141         (font-lock-fontify-syntactically-region (point-min) (point-max))))))
 142
 143 (defun sm-c--cpp-syntax-propertize (end)
 144   (let ((ppss (syntax-ppss))
 145         found)
 146     (when (sm-c--cpp-inside-p ppss)
 147       (while
 148           (and (setq found (re-search-forward "\\(\\\\\\\\\\)*\n" end 'move))
 149                (or (eq ?\\ (char-before (match-beginning 0)))
 150                    (with-syntax-table sm-c--cpp-syntax-table
 151                      (nth 4 (parse-partial-sexp (1+ (nth 8 ppss)) (point)))))))
 152       (when found
 153         (put-text-property (1- (point)) (point)
 154                            'syntax-table (string-to-syntax "> c"))))))
 155
 156 ;;;; Indenting CPP directives.
 157
 158 (defcustom sm-c-indent-cpp-basic 1
 159   "Indent step for CPP directives.
 160 If non-zero, CPP directives are indented according to CPP depth.
 161 E.g. a #define nested within 2 #ifs will be turned into \"#  define\"."
 162   :type 'integer)
 163
 164 (defun sm-c--cpp-prev (tok)
 165   (let ((offset nil))
 166     (while
 167         (when (re-search-backward sm-c--cpp-regexp nil t)
 168           (pcase (cons tok (match-string 3))
 169             (`(,_ . "endif") (sm-c--cpp-prev "endif"))
 170             ((or `(,(or "endif" "else" "elif") . ,(or "if" "ifdef" "ifndef"))
 171                  `(,(or "else" "elif") . "elif"))
 172              (setq offset 0))
 173             (`(,(or "endif" "else" "elif") . ,_) nil)
 174             (`(,_ . ,(or "if" "ifdef" "ifndef" "elif" "else"))
 175              (setq offset sm-c-indent-cpp-basic))
 176             (_ (setq offset 0)))
 177           (not offset)))
 178     (when offset
 179       (goto-char (match-beginning 3))
 180       (+ offset (current-column)))))
 181
 182
 183 (defun sm-c--cpp-indent-line (&optional _arg)
 184   ;; FIXME: Also align the terminating \, if any.
 185   (when (> sm-c-indent-cpp-basic 0)
 186     (let* ((pos (point-marker))
 187            (beg)
 188            (indent
 189             (save-excursion
 190               (forward-line 0)
 191               (when (looking-at sm-c--cpp-regexp)
 192                 (setq beg (match-beginning 3))
 193                 (or (sm-c--cpp-prev (match-string 3)) 0)))))
 194       (when indent
 195         (let ((before (<= pos beg)))
 196           (goto-char beg)
 197           (unless (= (current-column) indent)
 198             (skip-chars-backward " \t")
 199             (delete-region (point)
 200                            (progn (skip-chars-forward " \t") (point)))
 201             (indent-to indent))
 202           (unless before (goto-char pos)))))))
 203
 204 ;;;; Indenting inside CPP #define.
 205
 206 (defconst sm-c--cpp-smie-indent-functions
 207   ;; FIXME: Don't just align line after #define with the "d"!
 208   (mapcar
 209    (lambda (f)
 210      (cond
 211       ((eq f #'smie-indent-comment-inside) #'sm-c--cpp-indent-comment-inside)
 212       ;; ((eq f #'smie-indent-exps) #'sm-c--cpp-indent-exps)
 213       (t f)))
 214    (default-value 'smie-indent-functions)))
 215
 216 (defun sm-c--cpp-indent-comment-inside ()
 217   (let ((ppss (syntax-ppss)))
 218     (when (nth 4 ppss)
 219       ;; Indicate where's the comment start.
 220       `(noindent . ,(nth 8 ppss)))))
 221
 222 (defun sm-c--cpp-smie-indent ()
 223   (let ((ppss (syntax-ppss)))
 224     (cond
 225      ((sm-c--cpp-inside-p ppss)
 226       (save-restriction
 227         (narrow-to-region (nth 8 ppss) (point-max))
 228         (let ((indent
 229                (let ((smie-indent-functions sm-c--cpp-smie-indent-functions)
 230                      (syntax-ppss-cache nil)
 231                      (syntax-ppss-last nil)
 232                      (parse-sexp-lookup-properties nil))
 233                  (smie-indent-calculate))))
 234           (if (not (eq 'noindent (car-safe indent)))
 235               (if (integerp indent)
 236                   (max (funcall smie-rules-function :elem 'basic) indent)
 237                 indent)
 238             ;; We can't just return `noindent' if we're inside a comment,
 239             ;; because the indent.el code would then be similarly confused,
 240             ;; thinking the `noindent' is because we're inside the cpp
 241             ;; pseudo-comment, and would hence align the code with the content
 242             ;; of the psuedo-comment rather than the nested real comment!
 243             ;;
 244             ;; FIXME: Copy&paste from indent--default-inside-comment.
 245             ;; FIXME: This will always re-indent inside these comments, even
 246             ;; during indent-region.
 247             (save-excursion
 248               (forward-line -1)
 249               (skip-chars-forward " \t")
 250               (when (< (1- (point)) (cdr indent) (line-end-position))
 251                 (goto-char (cdr indent))
 252                 (when (looking-at comment-start-skip)
 253                   (goto-char (match-end 0))))
 254               (current-column))))))
 255
 256      ((equal (syntax-after (point)) (string-to-syntax "< c")) 0)
 257      )))
 258
 259 ;;; Syntax table
 260
 261 (defvar sm-c-mode-syntax-table
 262   (let ((st (make-syntax-table)))
 263     (modify-syntax-entry ?/ ". 124" st)
 264     (modify-syntax-entry ?* ". 23b" st)
 265     (modify-syntax-entry ?\n ">" st)
 266     (modify-syntax-entry ?\" "\"" st)
 267     (modify-syntax-entry ?\' "\"" st)
 268     (modify-syntax-entry ?= "." st)
 269     (modify-syntax-entry ?< "." st)
 270     (modify-syntax-entry ?> "." st)
 271     st))
 272
 273 (defun sm-c-syntax-propertize (start end)
 274   (goto-char start)
 275   (sm-c--cpp-syntax-propertize end)
 276   (funcall
 277    (syntax-propertize-rules
 278     (sm-c--cpp-regexp
 279      (2 (prog1 "< c"
 280           (when (and (equal (match-string 3) "include")
 281                      (looking-at "[ \t]*\\(<\\)[^>\n]*\\(>\\)"))
 282             (put-text-property (match-beginning 1) (match-end 1)
 283                                'syntax-table (string-to-syntax "|"))
 284             (put-text-property (match-beginning 2) (match-end 2)
 285                                'syntax-table (string-to-syntax "|")))
 286           (sm-c--cpp-syntax-propertize end)))))
 287    (point) end))
 288
 289 (defun sm-c-syntactic-face-function (ppss)
 290   (if (sm-c--cpp-inside-p ppss)
 291       (prog1 nil (sm-c--cpp-fontify-syntactically ppss))
 292     (funcall (default-value 'font-lock-syntactic-face-function) ppss)))
 293
 294 ;;; SMIE support
 295
 296 (defconst sm-c-paren-block-keywords '("if" "while" "for" "switch"))
 297
 298 (defconst sm-c-smie-precedence-table
 299   '((assoc ";")
 300     ;; Compiled from https://en.wikipedia.org/wiki/Operators_in_C_and_C++.
 301     (assoc ",")                         ;1
 302     ;; (nonassoc "throw")
 303     (nonassoc "=" "+=" "-=" "*=" "/=" "%=" "<<=" ">>=" "&=" "^=" "|=") ;2
 304     ;; (nonassoc "?" ":") ;; Better handle it in the BNF.
 305     (assoc "||")                        ;3
 306     (assoc "&&")                        ;4
 307     (assoc "|")                         ;5
 308     (assoc "^")                         ;6
 309     ;; (assoc "&") ;; Binary and.  Confused with address-of.
 310     (nonassoc "==" "!=")                ;7
 311     (nonassoc "<" "<=" ">" ">=")        ;8
 312     (nonassoc "<<" ">>")                ;9
 313     (assoc "+" "-")                     ;10
 314     (assoc "/" "* mult" "%")            ;11
 315     ;; (nonassoc ".*" "->*")            ;12   ;; Only C++
 316     ;; (nonassoc "++" "--" "+" "-" "!" "~" "(type)" "*" "&"
 317     ;;          "sizeof" "new" "delete");13  ;; All prefix.
 318     (left "." "->") ;; "++" "--" suffixes, "()", "[]", "typeid", "*_cast". ;14
 319     ;; (noassoc "::") ;; Only C++
 320     ))
 321
 322 (defconst sm-c-smie-grammar
 323   ;; `((: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))
 324   (let ((grm
 325          (smie-prec2->grammar
 326           (smie-merge-prec2s
 327            (smie-bnf->prec2
 328             '((decls ("typedef" decl) ("extern" decl)
 329                      (decls ";" decls))
 330               (decl)
 331               (id)
 332               (insts ("{" insts "}")
 333                      (insts ";" insts)
 334                      ("return" exp)
 335                      ("goto" exp)
 336                      (":label")
 337                      ("case" subexp ": case")
 338                      ("else" exp-if))
 339               (exp-if ("if" exp) ("do" exp) ("while" exp) ("switch" exp) ("for" exp)
 340                       (exp))
 341               (exp ("(" exp ")") (exp "," exp) (subexp "?" exp ":" exp))
 342               (subexp (subexp "||" subexp))
 343               ;; Some of the precedence table deals with pre/postfixes, which
 344               ;; smie-precs->prec2 can't handle, so handle it here instead.
 345               (exp11 (exp12) (exp11 "/" exp11))
 346               (exp12 (exp13))           ;C++ only.
 347               (exp13 (exp14) ("++ prefix" exp13) ("-- prefix" exp13)
 348                      ("!" exp13) ("~" exp13) ("&" exp13) ("* deref" exp13))
 349               (exp14 (id) (exp14 "++ postfix") (exp14 "-- postfix")
 350                      (exp14 "->" id) (exp14 "." id)))
 351             '((assoc ";") (assoc ",") (nonassoc "?" ":"))
 352             sm-c-smie-precedence-table)
 353            (smie-precs->prec2 sm-c-smie-precedence-table)
 354            (smie-precs->prec2 '((nonassoc ";") (nonassoc ":")))))))
 355     ;; SMIE gives (":label" 261 262), but really this could just as well be
 356     ;; (":label" nil nil) because labels don't have any argument to their left
 357     ;; or right.  They're like both openers and closers at the same time.
 358     (mapcar (lambda (x)
 359               (if (equal (car-safe x) ":label")
 360                   ;; Rather than (":label" (n1) (n2)) we use
 361                   ;; (":label" (n1) n2) because SMIE otherwise complains:
 362                   ;; cl--assertion-failed((numberp (funcall op-forw toklevels)))
 363                   ;; in smie-next-sexp.
 364                   `(,(nth 0 x) (,(nth 1 x)) ,(nth 2 x)) x))
 365             grm)))
 366
 367 ;; (defun sm-c--:-discriminate ()
 368 ;;   (save-excursion
 369 ;;     (and (null (smie-backward-sexp))
 370 ;;          (let ((prev (smie-indent-backward-token)))
 371 ;;            (cond
 372 ;;             ((equal prev "case" ) ": case")
 373 ;;             ((member prev '(";" "{" "}")) ":-label")
 374 ;;             (t ":"))))))
 375
 376 (defconst sm-c-smie-operator-regexp
 377   (let ((ops '()))
 378     (pcase-dolist (`(,token . ,_) sm-c-smie-grammar)
 379       (when (and (stringp token) (string-match "\\`[^ [:alnum:](){}]+" token))
 380         (push (match-string 0 token) ops)))
 381     (regexp-opt ops)))
 382
 383 (defun sm-c-smie-forward-token ()
 384   (forward-comment (point-max))
 385   (let ((tok (if (looking-at sm-c-smie-operator-regexp)
 386                  (progn (goto-char (match-end 0)) (match-string 0))
 387                (smie-default-forward-token))))
 388     (cond
 389      ((and (equal tok "") (looking-at "\\\\\n"))
 390       (goto-char (match-end 0))
 391       (sm-c-smie-forward-token))
 392      ((member tok '(":" "*"))
 393       (save-excursion (sm-c-smie-backward-token)))
 394      ((looking-at "[ \t]*:")
 395       (if (not (equal (save-excursion (sm-c-smie-forward-token)) ":label"))
 396           tok
 397         (looking-at "[ \t]*:")
 398         (goto-char (match-end 0)) ":label"))
 399      (t tok))))
 400
 401
 402 (defun sm-c-smie-backward-token ()
 403   (forward-comment (- (point)))
 404   (let ((tok (if (looking-back sm-c-smie-operator-regexp (- (point) 3) t)
 405                  (progn (goto-char (match-beginning 0)) (match-string 0))
 406                (smie-default-backward-token))))
 407     (cond
 408      ((and (equal tok "") (looking-at "\n"))
 409       (let ((pos (point)))
 410         (if (not (= 0 (mod (skip-chars-backward "\\\\") 2)))
 411             (sm-c-smie-backward-token)
 412           (goto-char pos)
 413           tok)))
 414      ((equal tok "*") (sm-c-smie--*-token))
 415      ((equal tok ":")
 416       (let ((pos1 (point))
 417             (prev (sm-c-smie-backward-token)))
 418         (if (zerop (length prev))
 419             (progn (goto-char pos1) tok)
 420           (let ((pos2 (point)))
 421             (pcase (car (smie-indent-backward-token))
 422               ("case" (goto-char pos1) ": case")
 423               ((or ";" "{" "}") (goto-char pos2) ":label")
 424               (_ (goto-char pos1) tok))))))
 425      (t tok))))
 426
 427 (defun sm-c--prev-token ()
 428   (car (smie-indent-backward-token)))
 429
 430 (defun sm-c--else-to-if ()
 431   (let ((pos (point)))
 432     (unless (equal (sm-c--prev-token) ";")
 433       (goto-char pos))
 434     (while
 435         (pcase (smie-backward-sexp)
 436           (`(,_ ,pos "if") (goto-char pos) nil) ;Found it!
 437           (`(,_ ,_ ";") nil)                    ;Can't find it!
 438           (`(,_ ,pos "else") (goto-char pos) (sm-c--else-to-if) t)
 439           (`(,_ ,pos "while")
 440            (goto-char pos) (unless (sm-c--while-to-do) (goto-char pos)) t)
 441           (`(t . ,_) nil)               ;Can't find it!
 442           (`(,_ ,pos . ,_) (goto-char pos) t)
 443           (`nil t)))))
 444
 445 (defun sm-c--while-to-do ()
 446   "Jump to the matching `do' and return non-nil, if any.  Return nil otherwise."
 447   (pcase (sm-c--prev-token)
 448     ("}"
 449      ;; The easy case!
 450      (forward-char 1) (backward-sexp 1)
 451      (equal (sm-c--prev-token) "do"))
 452     (";"
 453      (let ((found-do nil))
 454        (while
 455            (pcase (smie-backward-sexp)
 456              (`(,_ ,pos "do") (goto-char pos) (setq found-do t) nil)
 457              (`(,_ ,_ ";") nil)         ;Can't find it!
 458              (`(,_ ,pos "else") (goto-char pos) (sm-c--else-to-if) t)
 459              (`(,_ ,pos "while")
 460               (goto-char pos) (unless (sm-c--while-to-do) (goto-char pos)) t)
 461              (`(t . ,_) nil)            ;Can't find it!
 462              (`(,_ ,pos . ,_) (goto-char pos) t)
 463              (`nil (or (not (looking-at "{"))
 464                        (smie-rule-prev-p "=")))))
 465        found-do))))
 466
 467 (defun sm-c--skip-labels (max)
 468   (while
 469       (let ((start (point)))
 470         (pcase (sm-c-smie-forward-token)
 471           ("case"
 472            (smie-forward-sexp "case")
 473            (forward-comment (point-max))
 474            (if (>= (point) max) (progn (goto-char start) nil)
 475              t))
 476           (":label"
 477            (forward-comment (point-max))
 478            (if (>= (point) max) (progn (goto-char start) nil)
 479              t))
 480           (_ (goto-char start) nil)))))
 481
 482 (defun sm-c--boi (&optional inner)
 483   "Jump to the beginning-of-instruction.
 484 By default for things like nested ifs, it jumps to the outer if, but
 485 if INNER is non-nil, it stops at the innermost one."
 486   (while
 487       (let ((pos (point)))
 488         (pcase (smie-backward-sexp)
 489           (`(,_ ,_ ";") nil)            ;Found it!
 490           (`(,_ ,pos "else") (goto-char pos) (sm-c--else-to-if) t)
 491           (`(,_ ,pos "while")
 492            (goto-char pos) (unless (sm-c--while-to-do) (goto-char pos)) t)
 493           (`(,(pred numberp) ,pos . ,_) (goto-char pos) t)
 494           ((or `nil `(nil . ,_))
 495            (if (and (or (not (looking-at "{"))
 496                         (smie-rule-prev-p "="))
 497                     (not (bobp)))
 498                t
 499              (goto-char pos) nil))
 500           (`(,_ ,_ ,(or "(" "{" "[")) nil) ;Found it!
 501           (`(,_ ,pos ,(and tok
 502                            (guard (when inner
 503                                     (or (member tok sm-c-paren-block-keywords)
 504                                         (equal tok "do"))))))
 505            (goto-char pos) nil) ;Found it!
 506           (`(t ,(pred (eq (point-min))) . ,_) nil)
 507           (`(,_ ,pos . ,_) (goto-char pos) t)))))
 508
 509 ;; (defun sm-c--if-tail-to-head ()
 510 ;;   (pcase (sm-c--prev-token)
 511 ;;     (")"
 512 ;;      (forward-char 1) (backward-sexp 1)
 513 ;;      (pcase (sm-c--prev-token)
 514 ;;        ("if" nil)
 515 ;;        ((or "while" "for") (sm-c--if-tail-to-head))))
 516 ;;     ("do" (sm-c--if-tail-to-head))))
 517
 518 (defun sm-c--boe (tok)
 519   (let ((start (point))
 520         (res (smie-backward-sexp tok)))
 521     (when (member (nth 2 res) '("if" "while" "do" "for" "else"))
 522       (when (member (nth 2 res) '("if" "for"))
 523         (let ((forward-sexp-function nil))
 524           (forward-sexp 1))
 525         (forward-comment (point-max)))
 526       (when (looking-at "{")
 527         (let ((forward-sexp-function nil))
 528           (forward-sexp 1))
 529         (forward-comment (point-max)))
 530       (if (> (point) start) (goto-char start)))))
 531
 532 (defun sm-c-smie--*-token ()
 533   (save-excursion
 534     (let ((pos (point)))
 535       (pcase (car (smie-indent-backward-token))
 536         (")"
 537          ;; Can be a multiplication (as in "(a+b)*c"), or a deref
 538          ;; (as in "if (stop) *a = 0;")
 539          (if (and (goto-char (nth 1 (syntax-ppss)))
 540                   (eq ?\( (char-after))
 541                   (member (smie-default-backward-token) '("if" "for")))
 542              "* deref"
 543            "* mult"))
 544         ("]" "* mult")                         ;Multiplication.
 545         ((or "(" "[" "{" "}") "* deref")
 546         (`nil
 547          (goto-char pos)
 548          (let ((res nil))
 549            (while (not (or res (bobp)))
 550              (pcase (smie-backward-sexp)
 551                (`(,_ ,_ ,(or ";" "{")) (setq res "* deref"))
 552                ((and `nil (guard (looking-at "{"))) (setq res "* deref"))
 553                (`(,left ,_ ,op)
 554                 (if (and (numberp left)
 555                          (numberp (nth 2 (assoc op smie-grammar)))
 556                          (< (nth 2 (assoc op smie-grammar))
 557                             (nth 1 (assoc "* mult" smie-grammar))))
 558                     (smie-backward-sexp 'halfsexp)
 559                   (setq res "* mult")))))
 560            (or res "* mult")))
 561         (_ "* mult")))))
 562
 563 (defun sm-c-smie-hanging-eolp ()
 564   (let ((start (point))
 565         (prev (smie-indent-backward-token)))
 566     (if (and (not (numberp (nth 1 prev)))
 567              (save-excursion (equal (sm-c-smie-backward-token) ";")))
 568         ;; Treat instructions that start after ";" as always "hanging".
 569         (end-of-line)
 570       (goto-char start)))
 571   (skip-chars-forward " \t")
 572   (or (eolp)
 573       (forward-comment (point-max))
 574       (and (looking-at "\\\\\n")
 575            (goto-char (match-end 0)))))
 576
 577 (defvar sm-c-smie--inhibit-case/label-rule nil)
 578
 579 (defun sm-c--smie-virtual ()
 580   (if (and (smie-indent--bolp)
 581            (not (save-excursion
 582                   (member (sm-c-smie-forward-token)
 583                           '("case" ":label")))))
 584       (current-column)
 585     (let ((sm-c-smie--inhibit-case/label-rule t))
 586       (smie-indent-calculate))))
 587
 588 (defun sm-c-smie-rules (kind token)
 589   (pcase (cons kind token)
 590     (`(:elem . basic) sm-c-indent-basic)
 591     (`(:list-intro . ";")
 592      (save-excursion
 593        (forward-char 1)
 594        (if (and (null (smie-forward-sexp))
 595                 ;; FIXME: Handle \\\n as well!
 596                 (progn (forward-comment (point-max))
 597                        (looking-at "(")))
 598            nil
 599          t)))
 600     (`(:before . "else")
 601      (save-excursion
 602        (sm-c--else-to-if)
 603        `(column . ,(smie-indent-virtual))))
 604     (`(:before . "while")
 605      (save-excursion
 606        (when (sm-c--while-to-do)
 607          `(column . ,(smie-indent-virtual)))))
 608     (`(:before . ,(or "=" "+=" "-=" "*=" "/=" "%=" "<<=" ">>=" "&=" "^=" "|="))
 609      (save-excursion
 610        (sm-c--boe token)
 611        `(column . ,(+ (funcall smie-rules-function :elem 'basic)
 612                       (smie-indent-virtual)))))
 613     (`(:before . "if")
 614      (when (and (not (smie-rule-bolp)) (smie-rule-prev-p "else"))
 615        (save-excursion
 616          (smie-indent-backward-token)
 617          `(column . ,(sm-c--smie-virtual)))))
 618     ;; (`(:after . ,(or "=" "+=" "-=" "*=" "/=" "%=" "<<=" ">>=" "&=" "^=" "|="))
 619     ;;  (funcall smie-rules-function :elem 'basic))
 620     (`(:before . "{")
 621      (cond
 622       ((smie-rule-prev-p "=") nil)      ;Not a block of instructions!
 623       ((save-excursion
 624          (let ((pos (point)))
 625            (sm-c--boi 'inner) (sm-c--skip-labels (point-max))
 626            (let ((tok (save-excursion (sm-c-smie-forward-token))))
 627              (cond
 628               ((or (equal tok "typedef")
 629                    (and (member tok '("enum" "struct"))
 630                         ;; Make sure that the {...} is about this struct/enum,
 631                         ;; as opposed to "struct foo *get_foo () {...}"!
 632                         (save-excursion
 633                           (smie-indent-forward-token)
 634                           (smie-indent-forward-token)
 635                           (forward-comment (point-max))
 636                           (>= (point) pos))))
 637                `(column . ,(+ (if (save-excursion
 638                                     (goto-char pos)
 639                                     (smie-rule-hanging-p))
 640                                   0
 641                                 (funcall smie-rules-function :elem 'basic))
 642                               (smie-indent-virtual))))
 643               ((or (member tok sm-c-paren-block-keywords)
 644                    (equal tok "do"))
 645                nil)
 646               ((save-excursion
 647                  (goto-char pos)
 648                  (when (and (> (car (syntax-ppss)) 0)
 649                             (equal ")" (car (smie-indent-backward-token))))
 650                    (up-list -1)
 651                    `(column . ,(sm-c--smie-virtual)))))
 652               (t `(column . ,(smie-indent-virtual))))))))
 653       ((smie-rule-hanging-p)
 654        (cond
 655         ((smie-rule-prev-p "do" "else")
 656          (smie-indent-backward-token))
 657         ((smie-rule-prev-p ")")
 658          (smie-backward-sexp)
 659          (smie-indent-backward-token))
 660         (t (sm-c--boi 'inner)))
 661        `(column . ,(sm-c--smie-virtual)))
 662       (t
 663        (let ((pos (point)))
 664          (pcase (sm-c--prev-token)
 665            ((or "do" "else")
 666             (cond
 667              (sm-c-indent-braces
 668               `(column . ,(+ (funcall smie-rules-function :elem 'basic)
 669                              (smie-indent-virtual))))))
 670            (")" nil)
 671            (_ (goto-char pos) (sm-c--boi)
 672               (if (< (point) pos)
 673                   `(column . ,(sm-c--smie-virtual)))))))))
 674     (`(:before . "(")
 675      (save-excursion
 676        (let ((res (smie-backward-sexp)))
 677          (pcase res
 678            (`nil
 679             (if (looking-at "(")
 680                 ;; (unless (save-excursion
 681                 ;;           (member (sm-c-smie-backward-token)
 682                 ;;                   sm-c-paren-block-keywords))
 683                 ;;   `(column . ,(sm-c--smie-virtual)))
 684                 nil
 685               `(column . ,(+ (funcall smie-rules-function :elem 'basic)
 686                              (sm-c--smie-virtual)))))))))
 687     (`(:after . "else")
 688      (save-excursion
 689        (funcall smie-rules-function :elem 'basic)))
 690     (`(:after . ")")
 691      (save-excursion
 692        (let ((_ (progn (forward-char 1) (backward-sexp 1)))
 693              (pos (point))
 694              (prev (sm-c-smie-backward-token)))
 695          (cond
 696           ((member prev sm-c-paren-block-keywords)
 697            `(column . ,(+ (funcall smie-rules-function :elem 'basic)
 698                           (smie-indent-virtual))))
 699           ((and (looking-at "[[:alnum:]_]+(")
 700                 (save-excursion
 701                   (forward-line 0)
 702                   (and (bobp) (looking-at sm-c--cpp-regexp))))
 703            ;; Will be bumped up presumably by the "max" in
 704            ;; sm-c--cpp-smie-indent.
 705            `(column . 0))
 706           (t (goto-char pos) `(column . ,(sm-c--smie-virtual)))))))
 707     (`(:after . "}")
 708      (save-excursion
 709        (forward-char 1) (backward-sexp 1)
 710        (sm-c--boi)
 711        `(column . ,(sm-c--smie-virtual))))
 712     (`(:after . ";")
 713      (save-excursion
 714        (sm-c--boi)
 715        `(column . ,(sm-c--smie-virtual))))
 716     (`(:after . ":label")
 717      ;; Yuck!
 718      `(column . ,(sm-c--smie-virtual)))
 719     (`(:after . ": case")
 720      ;; Yuck!
 721      (save-excursion
 722        (smie-backward-sexp ": case")
 723        `(column . ,(sm-c--smie-virtual))))
 724     (`(:after . "* deref") `(column . ,(sm-c--smie-virtual)))
 725     ((and `(:before . ":label") (guard (not sm-c-smie--inhibit-case/label-rule)))
 726      (let ((ppss (syntax-ppss)))
 727        (when (nth 1 ppss)
 728          (save-excursion
 729            (goto-char (nth 1 ppss))
 730            `(column . ,(smie-indent-virtual))))))
 731     ((and `(:before . "case") (guard (not sm-c-smie--inhibit-case/label-rule)))
 732      (catch 'found
 733        (dolist (pos (reverse (nth 9 (syntax-ppss))))
 734          (save-excursion
 735            (goto-char pos)
 736            (and (looking-at "{")
 737                 (null (car-safe (smie-backward-sexp)))
 738                 (equal "switch" (sm-c-smie-backward-token))
 739                 (goto-char pos)
 740                 (throw 'found `(column . ,(smie-indent-virtual))))))))))
 741
 742 ;;; Backslash alignment
 743
 744 (defvar-local sm-c--bs-changed nil)
 745
 746 (defun sm-c--bs-after-change (beg end _len)
 747   (unless undo-in-progress
 748     (if (null sm-c--bs-changed)
 749         (setq sm-c--bs-changed (cons beg end))
 750       (cl-callf (lambda (x) (min x beg)) (car sm-c--bs-changed))
 751       (cl-callf (lambda (x) (max x end)) (cdr sm-c--bs-changed)))))
 752
 753 (defun sm-c--bs-realign ()
 754   (when sm-c--bs-changed
 755     (sm-c--bs-realign-1 (car sm-c--bs-changed) (cdr sm-c--bs-changed))
 756     (setq sm-c--bs-changed nil)))
 757
 758 (defun sm-c--bs-realign-1 (from to)
 759   (save-excursion
 760     (goto-char from)
 761     (end-of-line)
 762     (unless (zerop (mod (skip-chars-backward "\\\\") 2))
 763       (skip-chars-backward " \t")
 764       (setq from (point))
 765       (let ((col (current-column))
 766             start end)
 767         (while
 768             (progn (setq start (point))
 769                    (end-of-line 0)
 770                    (and (< (point) start)
 771                         (not (zerop (mod (skip-chars-backward "\\\\") 2)))))
 772           (skip-chars-backward " \t")
 773           (setq col (max (current-column) col)))
 774         (goto-char from)
 775         (while
 776             (progn (setq end (point))
 777                    (end-of-line 2)
 778                    (and (> (line-beginning-position) end)
 779                         (not (zerop (mod (skip-chars-backward "\\\\") 2)))))
 780           (skip-chars-backward " \t")
 781           (setq col (max (current-column) col)))
 782         (goto-char to)
 783         (beginning-of-line)
 784         (unless (or (> (point) end)       ;Don't realign if we changed outside!
 785                     (<= end start))        ;A lone \
 786
 787           (setq col (1+ col))         ;Add a space before the backslashes.
 788           (goto-char end)
 789           (end-of-line)
 790           (while (>= (point) start)
 791             (cl-assert (eq (char-before) ?\\))
 792             (forward-char -1)
 793             (let ((curcol (current-column)))
 794               (cond
 795                ((> col curcol) (indent-to col))
 796                ((< col curcol)
 797                 (move-to-column col t)
 798                 (delete-region (point)
 799                                (progn (skip-chars-forward " \t") (point))))))
 800             (end-of-line 0)))))))
 801
 802 ;;; Font-lock support
 803
 804 (defconst sm-c--comment-regexp
 805   "/\\(?:/.*\n\\|\\*\\(?:[^*]+\\(?:\\*+[^/*]\\)*\\)*\\*/\\)")
 806
 807 (defconst sm-c--defun-regexp
 808   (let* ((spc0 (concat "\\(?:\n?[ \t]\\|" sm-c--comment-regexp "\\)*"))
 809          (spc1 (concat "\n?[ \t]" spc0))
 810          (id "\\(?:\\sw\\|\\s_\\)+"))
 811     (cl-flet ((repeat (repetition &rest res)
 812                       (concat "\\(?:" (apply #'concat res) "\\)"
 813                               (pcase repetition
 814                                 ((pred symbolp) (symbol-name repetition))
 815                                 (1 "")))))
 816       (concat
 817        "^\\(?:"
 818        (repeat '* "\\*" spc0)
 819        (repeat '* id (repeat 1 spc1 "\\|" spc0 "\\*" spc0))
 820        "\\(" id "\\)[ \t\n]*("
 821        "\\|"
 822        "[ \t]*#[ \t]*define[ \t]+\\(?1:" id "\\)("
 823        "\\)"))))
 824
 825 (defconst sm-c-font-lock-keywords
 826   `((,sm-c--cpp-regexp (1 font-lock-preprocessor-face))
 827     ("\\_<\\(?:true\\|false\\)\\_>" (0 font-lock-constant-face))
 828     ("\\_<\\(case\\)\\_>[ \t]*\\([^: \t]+\\)"
 829      (1 font-lock-keyword-face)
 830      (2 font-lock-constant-face))
 831     ("\\(?:[{};]\\(\\)\\|^\\)[ \t]*\\([[:alpha:]_][[:alnum:]_]*\\)[ \t]*:"
 832      (2 (if (or (match-beginning 1)
 833                 (save-excursion (equal ":label" (sm-c-smie-backward-token))))
 834             font-lock-constant-face)))
 835     (,(let ((kws (delq nil (mapcar (lambda (x)
 836                                      (setq x (car x))
 837                                      (and (stringp x)
 838                                           (string-match "\\`[a-z]" x)
 839                                           x))
 840                                    sm-c-smie-grammar))))
 841         (concat "\\_<" (regexp-opt
 842                         (append
 843                          ;; Elements not in SMIE's grammar.  Either because
 844                          ;; they're uninteresting from a parsing point of view,
 845                          ;; or because SMIE's parsing engine can't handle them
 846                          ;; even poorly.
 847                          '("break" "continue" "struct" "enum" "union" "static")
 848                          ;; "case" already handled above.
 849                          (delete "case" kws)))
 850                 "\\_>"))
 851      (0 font-lock-keyword-face))
 852     (,sm-c--defun-regexp
 853      (1
 854       (prog1 font-lock-function-name-face
 855         (if (< (match-beginning 0) (line-beginning-position))
 856             (put-text-property (match-beginning 0) (match-end 0)
 857                                'font-lock-multiline t)))))))
 858
 859 (defconst sm-c--def-regexp
 860   (let ((spc0 (concat "\\(?:[ \t\n]\\|" sm-c--comment-regexp "\\)*"))
 861         (id "\\(?:\\sw\\|\\s_\\)+"))
 862     (concat sm-c--defun-regexp
 863             "\\|"
 864             "\\_<\\(?1:\\(?:struct\\|enum\\)[ \t]+" id "\\)" spc0 "{")))
 865
 866 ;;;###autoload
 867 (define-derived-mode sm-c-mode prog-mode "smC"
 868   "C editing mode based on SMIE."
 869   ;; (setq-local font-lock-support-mode nil) ;; To help debugging.
 870   (setq-local comment-start "/* ")
 871   (setq-local comment-end " */")
 872   (setq-local parse-sexp-lookup-properties t)
 873   (setq-local open-paren-in-column-0-is-defun-start nil)
 874   (setq-local syntax-propertize-function #'sm-c-syntax-propertize)
 875   (setq-local font-lock-defaults '(sm-c-font-lock-keywords))
 876   (setq-local font-lock-syntactic-face-function #'sm-c-syntactic-face-function)
 877   (smie-setup sm-c-smie-grammar #'sm-c-smie-rules
 878               :backward-token #'sm-c-smie-backward-token
 879               :forward-token #'sm-c-smie-forward-token)
 880   ;; FIXME: The stock SMIE forward-sexp-function is not good enough here, since
 881   ;; our grammar is much too poor.  We should setup another function instead
 882   ;; (or ideally teach SMIE to use it).
 883   (kill-local-variable 'forward-sexp-function)
 884   (add-hook 'smie-indent-functions #'sm-c--cpp-smie-indent nil t)
 885   (add-function :after (local 'indent-line-function)
 886                 #'sm-c--cpp-indent-line)
 887   (setq-local smie--hanging-eolp-function #'sm-c-smie-hanging-eolp)
 888   ;; Backslash auto-realign.
 889   (add-hook 'after-change-functions #'sm-c--bs-after-change nil t)
 890   (add-hook 'post-command-hook #'sm-c--bs-realign nil t)
 891   (setq-local add-log-current-defun-header-regexp sm-c--def-regexp)
 892   (setq-local imenu-generic-expression `((nil ,sm-c--def-regexp 1))))
 893
 894 (defun sm-c--cpp-is-not-really-a-comment (&rest args)
 895   ;; Without this, placing the region around a CPP directive and hitting
 896   ;; M-; would just strip the leading "#" instead of commenting things out.
 897   (if (not (derived-mode-p 'sm-c-mode))
 898       (apply args)
 899     (let ((parse-sexp-lookup-properties nil))
 900       (apply args))))
 901
 902 ;; FIXME: Maybe we should change newcomment.el instead; or maybe CPP directives
 903 ;; should not be defined as comments, or at least "not always"!
 904 (advice-add 'comment-only-p :around #'sm-c--cpp-is-not-really-a-comment)
 905
 906 (provide 'sm-c-mode)
 907 ;;; sm-c-mode.el ends here