dotemacs

My Emacs configuration
git clone git://git.entf.net/dotemacs
Log | Files | Refs | LICENSE

macrostep-c.el (6444B)


      1 ;;; macrostep-c.el --- macrostep interface to C preprocessor  -*- lexical-binding: t; -*-
      2 
      3 ;; Copyright (C) 2015 Jon Oddie
      4 
      5 ;; Author: Jon Oddie <j.j.oddie@gmail.com>
      6 ;; Url: https://github.com/emacsorphanage/macrostep
      7 ;; Keywords: c, languages, macro, debugging
      8 
      9 ;; SPDX-License-Identifier: GPL-3.0-or-later
     10 
     11 ;; This file is free software: you can redistribute it and/or modify
     12 ;; it under the terms of the GNU General Public License as published
     13 ;; by the Free Software Foundation, either version 3 of the License,
     14 ;; or (at your option) any later version.
     15 ;;
     16 ;; This file is distributed in the hope that it will be useful,
     17 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
     18 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
     19 ;; GNU General Public License for more details.
     20 ;;
     21 ;; You should have received a copy of the GNU General Public License
     22 ;; along with this file.  If not, see <https://www.gnu.org/licenses/>.
     23 
     24 ;;; Commentary:
     25 
     26 ;; A thin wrapper around Emacs's built-in `cmacexp' library to provide
     27 ;; basic support for expanding C macros using the `macrostep' user
     28 ;; interface.  To use, position point on a macro use in a C buffer and
     29 ;; type `M-x macrostep-expand'.  The variables `c-macro-preprocessor'
     30 ;; and especially `c-macro-cppflags' may need to be set correctly for
     31 ;; accurate expansion.
     32 
     33 ;; This is fairly basic compared to the Emacs Lisp `macrostep'.  In
     34 ;; particular, there is no step-by-step expansion, since C macros are
     35 ;; expanded in a single "cpp" pass, and no pretty-printing.
     36 
     37 ;; To hide the buffer containing "cpp" warnings (not recommended), you
     38 ;; could do something like:
     39 ;;
     40 ;; (push `(,(regexp-quote macrostep-c-warning-buffer)
     41 ;;          (display-buffer-no-window))
     42 ;;       display-buffer-alist)
     43 
     44 ;;; Code:
     45 
     46 (require 'macrostep)
     47 (require 'cmacexp)
     48 (require 'cl-lib)
     49 
     50 (require 'subr-x nil t)
     51 (defalias 'macrostep-c-string-trim
     52   (if (fboundp 'string-trim)
     53       #'string-trim
     54     (lambda (string)
     55       (when (string-match "\\`[ \t\n\r]+" string)
     56 	(setq string (replace-match "" t t string)))
     57       (when (string-match "[ \t\n\r]+\\'" string)
     58 	(setq string (replace-match "" t t string)))
     59       string)))
     60 
     61 (put 'macrostep-c-non-macro 'error-conditions
     62      '(macrostep-c-non-macro error))
     63 (put 'macrostep-c-non-macro 'error-message
     64      "Text around point is not a macro call.")
     65 
     66 (put 'macrostep-c-expansion-failed 'error-conditions
     67      '(macrostep-c-expansion-failed error))
     68 (put 'macrostep-c-expansion-failed 'error-message
     69      "Macro-expansion failed.")
     70 
     71 (defvar macrostep-c-warning-buffer "*Macroexpansion Warnings*")
     72 
     73 ;;;###autoload
     74 (defun macrostep-c-mode-hook ()
     75   (setq macrostep-sexp-bounds-function
     76         #'macrostep-c-sexp-bounds)
     77   (setq macrostep-sexp-at-point-function
     78         #'macrostep-c-sexp-at-point)
     79   (setq macrostep-environment-at-point-function
     80         #'ignore)
     81   (setq macrostep-expand-1-function
     82         #'macrostep-c-expand-1)
     83   (setq macrostep-print-function
     84         #'macrostep-c-print-function)
     85   (add-hook 'macrostep-mode-off-hook
     86             #'macrostep-c-mode-off nil t))
     87 
     88 (defun macrostep-c-mode-off (&rest _ignore)
     89   (when (derived-mode-p 'c-mode)
     90     (let ((warning-window
     91            (get-buffer-window macrostep-c-warning-buffer)))
     92       (when warning-window
     93         (quit-window nil warning-window)))))
     94 
     95 ;;;###autoload
     96 (add-hook 'c-mode-hook #'macrostep-c-mode-hook)
     97 
     98 (defun macrostep-c-sexp-bounds ()
     99   (save-excursion
    100     (cl-loop
    101      (let ((region (macrostep-c-sexp-bounds-1)))
    102        (cond
    103          ((null region)
    104           (signal 'macrostep-c-non-macro nil))
    105          ((macrostep-c-expandable-p region)
    106           (cl-return region))
    107          (t
    108           (condition-case nil
    109               (progn
    110                 (backward-up-list)
    111                 (skip-syntax-backward "-"))
    112             (scan-error
    113              (signal 'macrostep-c-non-macro nil)))))))))
    114 
    115 (defun macrostep-c-sexp-bounds-1 ()
    116   (let ((region (bounds-of-thing-at-point 'symbol)))
    117     (when region
    118       (cl-destructuring-bind (symbol-start . symbol-end) region
    119         (save-excursion
    120           (goto-char symbol-end)
    121           (if (looking-at "[[:space:]]*(")
    122               (cons symbol-start (scan-sexps symbol-end 1))
    123               region))))))
    124 
    125 (defun macrostep-c-expandable-p (region)
    126   (cl-destructuring-bind (start . end) region
    127     (condition-case nil
    128         (cl-destructuring-bind (expansion _warnings)
    129             (macrostep-c-expand-region start end)
    130           (and (cl-plusp (length expansion))
    131                (not (string= expansion (buffer-substring start end)))))
    132       (macrostep-c-expansion-failed nil))))
    133 
    134 (defun macrostep-c-sexp-at-point (start end)
    135   (cons start end))
    136 
    137 (defun macrostep-c-expand-1 (region _ignore)
    138   (cl-destructuring-bind (start . end) region
    139     (cl-destructuring-bind (expansion warnings)
    140         (macrostep-c-expand-region start end)
    141       (when (cl-plusp (length warnings))
    142         (with-current-buffer
    143             (get-buffer-create macrostep-c-warning-buffer)
    144           (let ((inhibit-read-only t))
    145             (erase-buffer)
    146             (insert warnings)
    147             (goto-char (point-min)))
    148           (special-mode)
    149           (display-buffer (current-buffer)
    150                           '(display-buffer-pop-up-window
    151                             (inhibit-same-window . t)
    152                             (allow-no-window . t)))))
    153       expansion)))
    154 
    155 (defun macrostep-c-expand-region (start end)
    156   (let ((expansion
    157          (condition-case nil
    158              (c-macro-expansion start end
    159                                 (concat c-macro-preprocessor " "
    160                                         c-macro-cppflags))
    161            (search-failed
    162             (signal 'macrostep-c-expansion-failed nil)))))
    163     (with-temp-buffer
    164       (save-excursion
    165         (insert expansion))
    166       (when (looking-at (regexp-quote "/*"))
    167         (search-forward "*/"))
    168       (let ((warnings (buffer-substring (point-min) (point)))
    169             (expansion (buffer-substring (point) (point-max))))
    170         (mapcar #'macrostep-c-string-trim (list expansion warnings))))))
    171 
    172 (defun macrostep-c-print-function (expansion &rest _ignore)
    173   (with-temp-buffer
    174     (insert expansion)
    175     (let ((exit-code
    176            (shell-command-on-region (point-min) (point-max) "indent" nil t)))
    177       (when (zerop exit-code)
    178         (setq expansion (macrostep-c-string-trim (buffer-string))))))
    179   (insert expansion))
    180 
    181 (provide 'macrostep-c)
    182 
    183 ;;; macrostep-c.el ends here