;;; cc-flymake.el --- Flymake backends for C/C++     -*- lexical-binding: t; -*-

;; Copyright (C) 2017 Free Software Foundation, Inc.

;; Author: João Távora <joaotavora@gmail.com>
;; Keywords: languages, c

;; This program is free software; you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
;; the Free Software Foundation, either version 3 of the License, or
;; (at your option) any later version.

;; This program is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
;; GNU General Public License for more details.

;; You should have received a copy of the GNU General Public License
;; along with this program.  If not, see <https://www.gnu.org/licenses/>.

;;; Commentary:

;; Flymake support for C/C++.

;;; Code:

(require 'subr-x) ; when-let*

(defcustom cc-flymake-command 'cc-flymake-use-special-make-target
  "Command used by the CC flymake backend.
A list of strings, or a symbol naming a function that produces one
such list when called with no arguments in the buffer where the
variable `flymake-mode' is active.

The command should invoke a GNU-style compiler that checks the
syntax of a (Obj)C(++) program passed to it via its standard
input and prints the result on its standard output."
  :type '(choice
          (symbol :tag "Function")
          ((repeat :) string))
  :group 'cc-flymake)

(defvar-local cc-flymake--cached-flags nil)

(defun cc-flymake--guess-flags (cc-program &optional trash-cache)
  "Guess C(++) flags for compiling current buffer.
Do this with by finding a suitable Makefile and intercepting an
invocation of CC-PROGRAM, a string naming a C(++) compiler, in
the output of \"make --just-print <file.o>\".

Cache the result. TRASH-CACHE of a change to the Makefile rests
the cache.

This function signals an error if it encounters any problems,
which normally causes using backends to be disabled.

Can also function interactively for debug purposes."
  (interactive (list (read-from-minibuffer "Compiler? ")
                     current-prefix-arg))
  (when trash-cache (setq cc-flymake--cached-flags nil))
  (catch 'retval
    (unless (buffer-file-name)
      ;; don't error and don't cache, so that when the buffer is saved
      ;; we get another chance.
      (throw 'retval nil))
    (when-let* ((makefile-dir
                 (locate-dominating-file default-directory "Makefile"))
                (makefile (expand-file-name "Makefile" makefile-dir))
                (mtime (file-attribute-modification-time
                        (file-attributes makefile))))
      (cond
       ((equal (list cc-program makefile mtime)
               (cdr cc-flymake--cached-flags))
        (when (called-interactively-p 'interactive)
          (message "cache HIT for %s flags: %S" cc-program
                   (car cc-flymake--cached-flags)))
        (throw 'retval (car cc-flymake--cached-flags)))
       (t
        (let*
            ((sans-nothing
              (file-name-nondirectory
               (file-name-sans-extension
                (buffer-file-name))))
             (blob (shell-command-to-string
                    (format "make -C %s -f %s --just-print %s.o"
                            makefile-dir
                            makefile
                            sans-nothing)))
             (match (string-match
                     (format "%s[[:space:]]+\\(\\(?:-.*\\)*\\)%s"
                             cc-program
                             sans-nothing)
                     blob))
             (flag-string (and match
                               (match-string 1 blob)))
             (flags (and flag-string
                         ;; FIXME: shell unescaping: Nothing here to
                         ;; deal with simple backslash-escaped spaces,
                         ;; like quoted and backquoted expressions,
                         ;; etc.
                         (split-string
                          flag-string
                          nil
                          nil
                          "[[:space:]]+"))))
          (when (or flags (string= "" flag-string))
            (setq cc-flymake--cached-flags
                  (list flags cc-program makefile mtime))
            (when (called-interactively-p 'interactive)
              (message "cache MISS for %s flags: %S" cc-program flags))
            (throw 'retval flags))))))
    (error "Could not guess %s flags" cc-program)))

(require 'compile)
(defun cc-flymake--make-diagnostics (source)
  "Parse the current buffer of compilation messages.
Return a list of diagnostics for the source buffer SOURCE."
  ;; TODO: if you can understand it, use `compilation-mode's regexps
  ;; or even some of its machinery here.
  ;;
  ;;    (set (make-local-variable 'compilation-locs)
  ;;         (make-hash-table :test 'equal :weakness 'value))
  ;;    (compilation-parse-errors (point-min) (point-max)
  ;;                              'gnu 'gcc-include)
  ;;    (while (next-single-property-change 'compilation-message)
  ;;       ...)
  ;;
  ;; For now, this works minimaly well.
  (cl-loop
   while
   (search-forward-regexp
    "^\\(In file included from \\)?<stdin>:\\([0-9]+\\):\\([0-9]+\\):\n?\\(.*\\): \\(.*\\)$"
    nil t)
   for msg = (match-string 5)
   for (beg . end) = (flymake-diag-region
                      source
                      (string-to-number (match-string 2))
                      (string-to-number (match-string 3)))
   for type = (if (match-string 1)
                  :error
                (assoc-default
                 (match-string 4)
                 '(("error" . :error)
                   ("note" . :note)
                   ("warning" . :warning))
                 #'string-match))
   collect (flymake-make-diagnostic source beg end type msg)))

(defun cc-flymake-use-special-make-target ()
  "Build command for checking a file with Make directly."
  (unless (executable-find "make") (error "Make not found"))
  `("make" "check-syntax" "CHK_SOURCES=-x c -"))

(defvar-local cc-flymake-program "cc"
  "C(++) compiler used by `cc-flymake-use-cc-directly'.")

(defun cc-flymake-use-cc-directly ()
  "Build command for checking a file with a C(++) compiler."
  (unless (executable-find cc-flymake-program)
    (error "%s not found" cc-flymake-program))
  `(,cc-flymake-program
    "-fsyntax-only"
    ,@(cc-flymake--guess-flags cc-flymake-program)
    "-x" "c" "-"))

(defvar-local cc-flymake--proc nil
  "Internal variable for `flymake-gcc'")

;;;###autoload
(defun cc-flymake (report-fn &rest _args)
  "Flymake backend for GNU-style C compilers.
This backend uses `cc-flymake-command' (which see) to launch a
process that is passed the current buffer's contents via stdin.
REPORT-FN is Flymake's callback."
  (when (process-live-p cc-flymake--proc)
    (kill-process cc-flymake--proc))
  (let ((source (current-buffer)))
    (save-restriction
      (widen)
      (setq
       cc-flymake--proc
       (make-process
        :name "gcc-flymake"
        :buffer (generate-new-buffer "*gcc-flymake*")
        :command (if (symbolp cc-flymake-command)
                     (funcall cc-flymake-command)
                   cc-flymake-command)
        :noquery t :connection-type 'pipe
        :sentinel
        (lambda (p _ev)
          (when (eq 'exit (process-status p))
            (unwind-protect
                (when (eq p cc-flymake--proc)
                  (with-current-buffer (process-buffer p)
                    (goto-char (point-min))
                    (let ((diags
                           (cc-flymake--make-diagnostics source)))
                      (if (or diags
                              (zerop (process-exit-status p)))
                          (funcall report-fn diags)
                        ;; non-zero exit with no diags is cause
                        ;; for alarm
                        (funcall report-fn
                                 :panic :explanation
                                 (buffer-substring
                                  (point-min) (progn (goto-char (point-min))
                                                     (line-end-position))))))))
              ;; (display-buffer (process-buffer p)) ; for debug
              (kill-buffer (process-buffer p)))))))
      (process-send-region cc-flymake--proc (point-min) (point-max))
      (process-send-eof cc-flymake--proc))))

(provide 'cc-flymake)
;;; cc-flymake.el ends here