;;; xr-prettify.el --- Display regular expressions as xr forms

;; Copyright (C) 2018 Clément Pit--Claudel
;; Author: Clément Pit--Claudel <clement.pitclaudel@live.com>
;; Version: 0.1
;; Keywords: convenience, lisp, tools

;; 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 <http://www.gnu.org/licenses/>.

;;; Commentary:

;; `xr-prettify-minor-mode' uses syntax highlighting and display properties to make ELisp
;; regular expressions more readable.  More precisely, it replaces "complex
;; enough" regular expressions with an equivalent "rx" form.  The underlying
;; buffer text is not modified.
;;
;; For example, `xr-prettify` prettifies this:
;;   "\\(?:\\_<\\\\newc\\_>\\s-*\\)?"
;; into this (`^' indicates a different color):
;;   (opt symbol-start "\\newc" symbol-end (zero-or-more (syntax whitespace)))
;;
;; The appearance of the replacement can be customized using `xr-prettify-face'
;; (which see).
;;
;; Suggested setup:
;;   (add-hook 'lisp-mode-hook 'xr-prettify-minor-mode)

;;; Code:

(require 'font-lock)
(require 'xr)

(defgroup xr-prettify nil
  "Display regular expressions in `rx' form."
  :group 'programming)

;; FIXME reveal while typing

(defun xr-prettify--maybe-replace-string ()
  "Possibly display the string starting before (point) as an `rx' form."
  (save-excursion
    (let ((ppss-state (syntax-ppss (point))))
      (when (nth 3 ppss-state)
        (let* ((start (1- (point)))
               (eol (point-at-eol))
               (end (save-excursion
                      (parse-partial-sexp (point) (1+ eol) nil
                                          nil ppss-state 'syntax-table)
                      (point))))
          (when (and (<= end eol)
                     (search-forward "\\\\" end t))
            (let* ((txt (buffer-substring-no-properties start end))
                   (str (ignore-errors (read txt)))
                   (rx (and str (ignore-errors (xr str))))
                   (pretty (and rx (prin1-to-string `(rx ,rx)))))
              (when (and pretty (not (string= pretty txt)))
                (put-text-property start end 'display pretty)))))))
    nil))

(defconst xr-prettify--keywords
  '(("\"" (0 (progn (xr-prettify--maybe-replace-string) nil))))
  "Font-lock keyword list used internally.")

;;;###autoload
(define-minor-mode xr-prettify-minor-mode
  "Display regular expressions in `rx' form to improve readability.
When this mode is active, strings are displayed in `rx' syntax,
and highlighted with `xr-prettify-face'."
  :lighter " xr"
  :group 'xr-prettify
  (cond
   (xr-prettify-minor-mode
    (font-lock-add-keywords nil xr-prettify--keywords)
    (make-local-variable 'font-lock-extra-managed-props)
    (add-to-list 'font-lock-extra-managed-props 'display))
   (t (font-lock-remove-keywords nil xr-prettify--keywords)))
  (if (>= emacs-major-version 25) (font-lock-flush)
    (with-no-warnings (font-lock-fontify-buffer))))

(provide 'xr-prettify)
;;; xr-prettify.el ends here