
(defun d-html--mode-keys ()
  (interactive)
  (auto-fill-mode 0)
  (modify-syntax-entry ?\" "$")

  (modify-syntax-entry ?' "_")
  (modify-syntax-entry ?` "_")
  (modify-syntax-entry ?_ "w")
  (modify-syntax-entry ?_ "w")
  (modify-syntax-entry ?\" "w")
  ;;(modify-syntax-entry ?\ "\\")
  (modify-syntax-entry ?. " ")

  ;;(local-set-key [f9] 'd-html-f9)
  (local-set-key [(meta ?\;)] 'd-html-meta-semicolon)
  (local-set-key "\t" 'd-html-tab-key)
  (local-set-key [(meta control \\)] 'd-html-meta-control-backslash)
  (if (not prefs-advanced-user-p)
      (local-set-key [f5] 'd-html-meta-control-backslash))

  (local-set-key [(meta ?q)] 'd-html-meta-q)
  (local-set-key "\C-m" 'd-html-enter)
  (local-set-key "\C-t" 'd-html-t)
  (local-unset-key [mouse-3])

  (abbrev-mode 1)
  (setq local-abbrev-table java-mode-abbrev-table)

  (d-html--check-for-marcus-mode)
  (d-html--check-for-php-code)
  )
(add-hook 'html-mode-hook 'd-html--mode-keys)

 ;; auto-indentation features...

(defun d-html-t ()
  (interactive)
  (setq w (current-word))
  (goto-char 0)
  (re-search-forward (concat "function " w)))

;;(setq tempref nil)

(defvar d-html--basic-offset 2)
(defvar d-html--marcus-mode nil)

;; Adds marcus on the modeline !!!
(add-to-list 'minor-mode-alist '(d-html--marcus-mode " Marcus"))

(defun d-html--check-for-marcus-mode ()
  (make-local-variable 'd-html--marcus-mode)
  (setq d-html--marcus-mode
        (if (save-excursion
              (save-restriction
                (beginning-of-buffer)
                (re-search-forward "</[pP]>" nil t)))
            t)))

;; (d-html--check-for-php-code)
(defun d-html--check-for-php-code ()
  (if (save-excursion
        (goto-char (point-min))
        (if (re-search-forward "<\\?php" nil t) t))
      (progn
        (setq mode-name "PHP")
        (modify-syntax-entry ?< ".")
        (modify-syntax-entry ?> ".")
        ;;(d-beeps "php mode detected")
        )
    (progn
      (setq mode-name "HTML")
      (modify-syntax-entry ?< "(>")
      (modify-syntax-entry ?> ")<")
      )))

(defun d-html--get-dif-of-region (start end)
  (-
   (save-excursion
     (goto-char start)
     (let ((case-fold-search t)
           (count            0)
           (s                nil))
       (while (re-search-forward "<[a-z]+" end t)
         (setq s (downcase (buffer-substring-no-properties (match-beginning 0) (match-end 0))))
         (if (and (if d-html--marcus-mode t (not (string= "<p" s)))
                  (not (string= "<img" s))
                  (not (string= "<li" s))
                  (not (string= "<html" s))
                  (not (string= "<body" s))
                  (not (string= "<br" s))
                  (not (string= "<dd" s))
                  (not (string= "<dt" s))
                  (not (string= "<link" s))
                  (not (string= "<o" s))
                  (not (string= "<param" s))

                  (not (string= "<small" s))
                  (not (string= "<font" s))
                  (not (string= "<span" s))

                  (not (string= "<input" s))
                  ;;(not (string= "<option" s))

                  (not (string= "<meta" s))
                  (not (string= "<hr" s))
                  (not (string= "<a" s))
                  (not (string= "<em" s))
                  (not (string= "<i" s))

                  (not (string= "<pre" s))
                  (not (string= "<frame" s))
                  (not (string= "<basefont" s))
                  )
;;                 (and (string-match "<a" s)
;;                      (not (looking-at " +$"))))
             (progn
               (incf count)
               ;;            (setq tempref (cons s tempref))
               )
           )
         )
       count
       )
     )
   (save-excursion
     (goto-char start)
     (let ((case-fold-search t)
           (count 0))
       (while (re-search-forward "</[a-z]+" end t)
         (setq s (downcase (buffer-substring-no-properties (match-beginning 0) (match-end 0))))
         (if (and (not (string= "</html" s))
                  (not (string= "</body" s))
                  (if d-html--marcus-mode t (not (string= "</p" s)))
                  (not (string= "</li" s))
                  (not (string= "</a" s))
                  (not (string= "</em" s))
                  (not (string= "</i" s))
                  (not (string= "</br" s))
                  (not (string= "</pre" s))
                  (not (string= "</small" s))
                  (not (string= "</font" s))
                  (not (string= "</span" s))
                  ;;(not (string= "</form" s))

                  )
             (incf count)))
       count
       )
     )
   )
  )

;; <adsa><dfssdf><adf><p><break></crap>

(defun d-html--get-dif-of-current-line ()
  (if (save-excursion
        (beginning-of-line)
        (looking-at "^[ \t]*m4_dnl"))
      (progn
        ;;(d-foo)
        0
        )
    (d-html--get-dif-of-region (point-at-bol)
                               (point-at-eol))))

(defun d-html--get-current-indentation ()
  (save-excursion
    (beginning-of-line)
    (if (looking-at "^[\t ]*")
        (- (match-end 0) (match-beginning 0))
      0)
    )
  ;;(current-column)
  )

(defun d-html--safe-make-string (len char)
  (if (>= len 0)
      (make-string len char)
      ""))

(defun d-html--set-current-indentation (must-be)
  (let ((cur (d-html--get-current-indentation)))
    (if (/= cur must-be)
        (save-excursion
          (beginning-of-line)
          (looking-at "^[\t ]*")
          (delete-region (match-beginning 0) (match-end 0))
          (insert (d-html--safe-make-string must-be ?\ ))))))

(defun d-html--goto-previous-nontrivial-line ()
  (forward-line -1)
  (while (and (looking-at "^[\t ]*$") (/= (point) (point-min)))
    (forward-line -1))
  (beginning-of-line)
  )

(defun d-html--inside-pre-pre-block ()
  (if (save-excursion
        (beginning-of-line)
        (looking-at "^[ \t]*</pre>"))

      nil
    (> (or (save-excursion
             (beginning-of-line)
             (re-search-backward "<pre>" nil t))
           0)
       (or (save-excursion
             (beginning-of-line)
             (re-search-backward "</pre>" nil t))
           0))))

(defun d-html--inside-m4-indent-block ()
  (if (save-excursion
        (beginning-of-line)
        (looking-at "^[ \t]*m4_end_indent$"))
      nil
    (> (or (save-excursion
             (beginning-of-line)
             (re-search-backward "^[ \t]*m4_begin_indent$" nil t))
           0)
       (or (save-excursion
             (beginning-of-line)
             (re-search-backward "^[ \t]*m4_end_indent$" nil t))
           0))))

(defun d-html--inside-fontify-block ()
  (let ((p (point)))
    (save-excursion
      (when (re-search-backward "^m4_fontify(" nil t)
        (skip-chars-forward "a-zA-Z0-9_")
        (forward-sexp)
        (< p (point))))))

(defun d-html--inside-php-block ()
  (if (save-excursion (re-search-backward "\\?>" nil t))
      (if (> (save-excursion
               (if (re-search-backward "<\\?php" nil t)
                   (point)
                 0))
             (save-excursion
               (if (re-search-backward "\\?>" nil t)
                   (point)
                 0)))
          t)
    (if (save-excursion
          (re-search-backward "<\\?php" nil t))
        t)))

(defun d-html--inside-javascript-block ()
  (if (save-excursion (re-search-backward "</script>" nil t))
      (if (> (save-excursion
               (if (re-search-backward "<script " nil t)
                   (point)))
             (save-excursion
               (if (re-search-backward "</script>" nil t)
                   (point))))
          t)
    (if (save-excursion
          (re-search-backward"<script " nil t))
        t)))

(defun d-html--get-brace-count ()
  (let ((count 0))
    (save-excursion
      (beginning-of-line)
      (while (re-search-forward "{" (point-at-eol) t)
        (incf count)))
    (save-excursion
      (beginning-of-line)
      (while (re-search-forward "}" (point-at-eol) t)
        (decf count)))
    count))

(defun d-html-tab-key (&optional not-check-marcus-mode)
  (interactive)
  ;;(c-indent-command)

  (if (not not-check-marcus-mode)
      (d-html--check-for-marcus-mode))

  (d-html--check-for-php-code)

  (progn
    (beginning-of-line)
    (if (re-search-forward "^\\([ \t]*\\)[^ ]" (point-at-eol) t)
      (delete-region (match-beginning 1) (match-end 1))))

  (let (proper-i)

    (setq proper-i (cond ((d-html--inside-php-block)
                          (cond
                           ((save-excursion (beginning-of-line) (looking-at "^[ \t]*}[ \t]*$"))
                            (save-excursion
                              (d-html--goto-previous-nontrivial-line)
                              (- (d-html--get-current-indentation) d-html--basic-offset)))
                           ((save-excursion (d-html--goto-previous-nontrivial-line) (looking-at ".*{[ \t]*$"))
                            (save-excursion
                              (d-html--goto-previous-nontrivial-line)
                              (+ (d-html--get-current-indentation) d-html--basic-offset)))
                           (t
                            (save-excursion
                              (d-html--goto-previous-nontrivial-line)
                              (d-html--get-current-indentation)))))
                         ;; (* d-html--basic-offset (d-html--get-brace-count)))))))

                         ((d-html--inside-javascript-block)
                          (cond
                           ((save-excursion
                              (beginning-of-line)
                              (looking-at "^[ \t]*$"))
                            (current-column))
                           ((save-excursion (beginning-of-line) (looking-at "^[ \t]*}[ \t]*$"))
                            (save-excursion
                              (d-html--goto-previous-nontrivial-line)
                              (- (d-html--get-current-indentation) d-html--basic-offset)))
                           ((save-excursion (d-html--goto-previous-nontrivial-line) (looking-at "^[ \t]*{[ \t]*$"))
                            (save-excursion
                              (d-html--goto-previous-nontrivial-line)
                              (+ (d-html--get-current-indentation) d-html--basic-offset)))
                           (t
                            (save-excursion
                              (d-html--goto-previous-nontrivial-line)
                              (d-html--get-current-indentation)))))

                         ((d-html--inside-pre-pre-block)
                          (if (save-excursion
                                (beginning-of-line)
                                (looking-at "^[ \t]*$"))
                              (current-column)
                            (d-html--get-current-indentation)))

                         ((d-html--inside-m4-indent-block)
                          (if (save-excursion
                                (beginning-of-line)
                                (looking-at "^[ \t]*$"))
                              (current-column)
                            (d-html--get-current-indentation)))

                         ((d-html--inside-fontify-block)
                          (if (save-excursion
                                (beginning-of-line)
                                (looking-at "^[ \t]*$"))
                              (current-column)
                            (d-html--get-current-indentation)))

                         ((save-excursion
                            (beginning-of-line)
                            (looking-at "^[ \t]*</pre>"))
                          (save-excursion
                            (assert (re-search-backward "^[ \t]*<pre>" nil t))
                            (d-html--get-current-indentation)))

                         ((save-excursion
                            (beginning-of-line)
                            (looking-at "^[ \t]*m4_end_indent"))
                          (save-excursion
                            (assert (re-search-backward "^[ \t]*m4_begin_indent$" nil t))
                            (d-html--get-current-indentation)))

                         (t

                          (let ((prev-line-start (save-excursion
                                                   (d-html--goto-previous-nontrivial-line)
                                                   (point)))
                                (cur-line-start (point-at-bol)))

                            (if (eq prev-line-start cur-line-start)
                                (progn
                                  ;;(d-foo)
                                  0)
                              (let (pdif cdif must-be)

                                (setq pdif (* d-html--basic-offset
                                              (save-excursion
                                                (d-html--goto-previous-nontrivial-line)
                                                (d-html--get-dif-of-current-line))))

                                (if (< pdif 0) (setq pdif 0))

                                (setq cdif (* d-html--basic-offset (d-html--get-dif-of-current-line)))

                                (if (> cdif 0) (setq cdif 0))

                                (setq must-be (+ (+ pdif) (+ cdif)
                                                 (save-excursion
                                                   (d-html--goto-previous-nontrivial-line)
                                                   (d-html--get-current-indentation))))
                                )))

                          ;; END COND!
                          ))
          ;; END SETQ!
          )

    (d-html--set-current-indentation proper-i)
    ;; END LET!
    )

  (beginning-of-line)
  (skip-chars-forward " ")

  ;;(if (and (eq (current-column) 0) (not (eolp))) (skip-chars-forward " ")
  ;; END DEFUN!
  )

(defun d-html-meta-control-backslash ()
  (interactive)
  (save-excursion
    (d-html--check-for-marcus-mode)
    ;; COOL! removes tab characters
    (goto-char (point-min))
    (while (re-search-forward "\t" nil t)
      (replace-match (make-string 8 ? )))

    (progn
      ;; COOL! removes " ! " -> "!"
      (goto-char (point-min))
      (while (re-search-forward " ! " nil t)
        (replace-match "!")))

    (progn
      ;; COOL! replaces OR! with OR !
      (goto-char (point-min))
      (while (re-search-forward "OR!" nil t)
        (replace-match "OR !")))

    (progn
      ;; COOL! replaces OR! with OR !
      (goto-char (point-min))
      (while (re-search-forward "AND!" nil t)
        (replace-match "AND !")))

    (progn
      ;; COOL! replaces ( foo with (foo
      (goto-char (point-min))
      (while (re-search-forward "( \\([a-zA-Z0-9$()']\\)" nil t)
        (replace-match "(\\1")))

    (progn
      ;; COOL! replaces foo ) with foo)
      (goto-char (point-min))
      (while (re-search-forward "\\([a-zA-Z0-9$()']\\) )" nil t)
        (replace-match "\\1)")))

    (progn
      ;; COOL! moves opening squiggly
      (goto-char (point-min))
      (while (re-search-forward "^.*[a-z].*{[ \t]*$" nil t)
        (re-search-backward "{" nil t)
        (forward-char -1)
        (insert "\n")
        (re-search-forward "{" nil t)
        ))

    (save-excursion
      (goto-char (point-min))
      (d-html-tab-key t)
      (while (/= (point) (point-max))
        (forward-line 1)
        (d-html-tab-key t)
        ))))

(defun d-html-meta-q ()
  (interactive)
  (save-excursion
    (beginning-of-line)
    (if (not (looking-at " +"))
        (fill-paragraph nil) ;; use builtin version

      (let (amt spaces re re2 min max max2)
        (setq amt (- (match-end 0) (match-beginning 0)))
        (setq spaces (d-html--safe-make-string amt ?\ ))
        (setq re (concat "^" spaces "[^ \n]"))
        (setq re2 (concat "^" spaces "<p>"))

        (save-excursion
          (forward-line -1)
          (while (and (looking-at re)
                      (not (looking-at re2)))
            (forward-line -1))
          (forward-line 1)
          ;;        (insert "<")
          (setq min (point)))

        (save-excursion
          (forward-line 1)
          (while (and (looking-at re)
                      (not (looking-at re2)))
            (forward-line 1))
          (forward-line -1)
          (skip-chars-forward " ")
          ;;        (insert ">")
          (setq max (point))

          (end-of-line)
          (setq max2 (point))
          )

        (let ((fill-column (- fill-column
                              amt)))

          (save-restriction
            (narrow-to-region min max2)
            (delete-extract-rectangle min max)

            ;;          (goto-char (point-max))
            ;;          (insert "!")
            ;;          (goto-char (point-min))
            ;;          (insert "!")

            (fill-paragraph nil)

            (goto-char (point-max))
            (beginning-of-line)
            (setq max (point))

            (string-rectangle min max spaces)
            (goto-char (1- (point-max)))
            (if (eq ?\n (char-after (point)))
                (delete-char 1))

            ;;        (string-rectangle min max "*")
            ))))))

(defun d-html-enter ()
  (interactive)
  (let (p)

    (if (save-excursion
          (beginning-of-line)
          (looking-at "^[ \t]*m4_dnl"))
        (setq p t))

    (insert "\n")
    ;;(execute-kbd-macro "\t")
    (d-html-tab-key)

    (if p
        (insert "m4_dnl "))))

(defun d-html--update-output-buffers ()
  "Updates output buffers after a compilation"
  (save-window-excursion
    ;;(d-foo)
    (let* ((list (buffer-list))
           (ptr  list)
           (name nil))
      (while ptr
        (setq name (buffer-file-name (car ptr)))
        (when (and name (string-match "/output/" name)
                   (save-excursion (set-buffer (car ptr)) buffer-read-only)
                   (not (buffer-modified-p (car ptr))))
          ;;(d-foo)
          (kill-buffer (car ptr))
          (find-file name))
        (setq ptr (cdr ptr))))))

(defadvice d-compilation-finish-function (after d-html activate)
  (d-html--update-output-buffers))

(global-set-key [(f10)]         'd-html-f10)
(global-set-key [(control f10)] 'd-html-shift-f10)
(global-set-key [(meta f10)]    'd-html-shift-f10)
(global-set-key [(shift f10)]   'd-html-shift-f10)

(defun d-html-f10 ()
  (interactive)

  (let (filename)

    (if (and (not (eq major-mode 'html-mode))
             (not (eq major-mode 'dired-mode))
             (not (eq major-mode 'compilation-mode)))
        (error "Error: The current file must compilation mode or dired mode or HTML mode"))

    (cond
     ((eq major-mode 'compilation-mode)
      ;;(d-foo)
      (let* ((list (buffer-list))
             (ptr  list)
             (done nil)
             (name nil))
        (while (and ptr (not done))
          (setq name (buffer-file-name (car ptr)))
          (if (and name (or (string-match "\\.hts$" name) (string-match "\\.m4$" name)))
              (setq done t))
          (setq ptr (cdr ptr)))
        (if done
            (find-file name)
          (setq ptr list)
          (while (and ptr (not done))
            (setq name (buffer-file-name (car ptr)))
            (if name
                (setq done t))
            (setq ptr (cdr ptr)))
          (if done
              (find-file name)
            (error "Error: No buffer found")))))

     ((eq major-mode 'html-mode)
      (setq filename (buffer-file-name))
      (assert filename)
      (if (string-match "\\.[Hh][Tt][Mm][Ll]?$" filename)
        (progn
          (save-buffer)
          (shell-command (concat "firefox \"" filename "\"")))
      (cond
       ((string-match "\\.hts$" filename)
        (setq ok t)
        (setq filename (concat (substring filename 0 (match-beginning 0)) ".html")))
       ((string-match "\\.m4$" filename)
        (setq ok t)
        (setq filename (concat (substring filename 0 (match-beginning 0)) ".html")))
       (t
        (error "Error: Should never happen")))

      (if (not (d-last-string-match "/src/" filename))
          (error "Error: Folder src not found")
        (setq filename (concat (substring filename 0 (match-beginning 0))
                               "/output/"
                               (substring filename (match-end 0))))
        (if (not (file-exists-p filename))
            (error "Error: File %s not found" filename))
        (find-file filename)
        )))

     ((eq major-mode 'dired-mode)
      (setq filename dired-directory)
      (if (not (d-last-string-match "/src/" filename))
          (error "Error: folder src not found")
        (setq filename (concat (substring filename 0 (match-beginning 0))
                               "/output/"
                               (substring filename (match-end 0))))
        (if (not (file-exists-p filename))
            (error "Error: File %s not found" filename))
        (dired filename)
        (revert-buffer)
        )))))

(defun d-html-shift-f10 ()

  (interactive)

  (let (filename)

    (if (and (not (eq major-mode 'html-mode)) (not (eq major-mode 'dired-mode)))
        (error "Error: The current file must dired mode or HTML mode"))

    (cond
     ((eq major-mode 'html-mode)
      (setq filename (buffer-file-name))
      (assert filename)

      (if (not (string-match "\\.[Hh][Tt][Mm][Ll]?$" filename))
          (error "Error: must be looking at an HTML mode file"))

      (setq filename (concat (substring filename 0 (match-beginning 0)) ".hts"))
      (if (not (d-last-string-match "/output/" filename))
          (error "Error: Folder output not found")
        (setq filename (concat (substring filename 0 (match-beginning 0))
                               "/src/"
                               (substring filename (match-end 0))))
        (if (not (file-exists-p filename))
            (error "File %s not found" filename))
        (find-file filename)))

     ((eq major-mode 'dired-mode)
      (setq filename dired-directory)
      (if (not (d-last-string-match "/output/" filename))
          (error "Error: Folder output not found")
        (setq filename (concat (substring filename 0 (match-beginning 0))
                               "/src/"
                               (substring filename (match-end 0))))
        (if (not (file-exists-p filename))
            (error "Error: File %s not found" filename))
        (dired filename)
        (revert-buffer)
        )))))

(defun d-html-meta-semicolon ()
  (interactive)
  "Toggles the commenting out of an HTML tag..."
  (progn
    ;; get to angle bracket
    (search-forward "<" nil 'end)
    (backward-char 1))
  (if (looking-at "<!--")
      (let ((p (1+ (point))))
        (forward-sexp 1)
        (backward-char 1)
        (backward-delete-char 2)
        (goto-char p)
        (delete-char 3)
        (backward-char 1))
    (if (looking-at "<")
        (let ((p (1+ (point))))
          (forward-sexp 1)
          (backward-char 1)
          (insert "--")
          (goto-char p)
          (insert "!--")
          (backward-char 4)))
    )
  (progn
    ;; get to next angle bracket
    (forward-char 1)
    (search-forward "<" nil 'end)
    (if (not (eobp)) (backward-char 1)))
  )

(if (boundp 'write-file-functions)
    (setq write-file-functions (cons 'php-hook write-file-functions)))

(defun php-hook ()
  (when (eq major-mode 'html-mode)
    (save-excursion
      (goto-char (point-min))
      (while (re-search-forward "\\([ \t]+$\\)" nil t)
        (delete-region (match-beginning 1) (match-end 1))))
    nil))

(provide 'd-html)
;;; d-html.el ends here
