;;; mhtml-mode.el --- HTML editing mode that handles CSS and JS -*- lexical-binding:t -*-

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

;; Keywords: wp, hypermedia, comm, languages

;; This file is part of GNU Emacs.

;; GNU Emacs 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.

;; GNU Emacs 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 GNU Emacs.  If not, see <http://www.gnu.org/licenses/>.

;;; Code:

(eval-and-compile
  (require 'sgml-mode)
  (require 'smie))
(require 'js)
(require 'css-mode)
(require 'prog-mode)

(cl-defstruct mhtml--submode
  ;; Name of this mode.
  name
  ;; HTML end tag.
  end-tag
  ;; Syntax table.
  syntax-table
  ;; Propertize function.
  propertize
  ;; Indentation function.
  indenter
  ;; Keymap.
  keymap)

(defconst mhtml--css-submode
  (make-mhtml--submode :name "CSS"
                       :end-tag "</style>"
                       :syntax-table css-mode-syntax-table
                       :propertize css-syntax-propertize-function
                       :indenter #'css-advertized-indent-line
                       :keymap css-mode-map))

(defconst mhtml--js-submode
  (make-mhtml--submode :name "JS"
                       :end-tag "</script>"
                       :syntax-table js-mode-syntax-table
                       :propertize #'js-syntax-propertize
                       :indenter #'js-indent-line
                       :keymap js-mode-map))

(defun mhtml--submode-lighter ()
  "Mode-line lighter indicating the current submode."
  (let ((submode (get-text-property (point) 'mhtml-submode)))
    (if submode
        (mhtml--submode-name submode)
      "")))

(defun mhtml--syntax-propertize-submode (submode end)
  (save-excursion
    (when (search-forward (mhtml--submode-end-tag submode) end t)
      (setq end (match-beginning 0))))
  (set-text-properties (point) end
                       (list 'mhtml-submode submode
                             'syntax-table (mhtml--submode-syntax-table submode)
                             ;; We want local-map here so that we act
                             ;; more like the sub-mode and don't
                             ;; override minor mode maps.
                             'local-map (mhtml--submode-keymap submode)
                             'cursor-sensor-functions
                             (list (lambda (_window _old-point _action)
                                     (force-mode-line-update)))))
  (funcall (mhtml--submode-propertize submode) (point) end)
  (goto-char end))

(defun mhtml-syntax-propertize (start end)
  (goto-char start)
  (when (get-text-property (point) 'mhtml-submode)
    (mhtml--syntax-propertize-submode (get-text-property (point) 'mhtml-submode)
                                      end))
  (funcall
   (syntax-propertize-rules
    ("<style.*?>"
     (0 (ignore
         (goto-char (match-end 0))
         (mhtml--syntax-propertize-submode mhtml--css-submode end))))
    ("<script.*?>"
     (0 (ignore
         (goto-char (match-end 0))
         (mhtml--syntax-propertize-submode mhtml--js-submode end))))
    sgml-syntax-propertize-rules)
   ;; Make sure to handle the situation where
   ;; mhtml--syntax-propertize-submode moved point.
   (point) end))

(defun mhtml-indent-line ()
  "Indent the current line as HTML, JS, or CSS, according to its context."
  (interactive)
  (let ((submode (save-excursion
                   (back-to-indentation)
                   (get-text-property (point) 'mhtml-submode))))
    (if submode
        (save-restriction
          (let* ((region-start (previous-single-property-change (point)
                                                                'mhtml-submode))
                 (base-indent (save-excursion
                                (goto-char region-start)
                                (sgml-calculate-indent))))
            (narrow-to-region region-start (point-max))
            (let ((prog-indentation-context (list base-indent
                                                  (cons (point-min) nil)
                                                  nil)))
              (funcall (mhtml--submode-indenter submode)))))
      ;; HTML.
      (sgml-indent-line))))

;;;###autoload
(define-derived-mode mhtml-mode html-mode
  '((sgml-xml-mode "XHTML+" "HTML+") (:eval (mhtml--submode-lighter)))
  "Major mode based on `html-mode', but works with embedded JS and CSS.

Code inside a <script> element is indented using the rules from
`js-mode'; and code inside a <style> element is indented using
the rules from `css-mode'."
  (cursor-sensor-mode)
  (setq-local indent-line-function #'mhtml-indent-line)
  (setq-local parse-sexp-lookup-properties t)
  (setq-local syntax-propertize-function #'mhtml-syntax-propertize)
  (add-hook 'syntax-propertize-extend-region-functions
            #'syntax-propertize-multiline 'append 'local))

(provide 'mhtml-mode)

;;; mhtml-mode.el ends here