;;; d-comp.el --- Fontifies the compilation buffer when compilation exits.

;; Copyright (C) 2006-2015 Davin Pearson

;; Emacs Lisp Archive Entry
;; Filename: d-comp.el
;; Author/Maintainer: m4_davin_pearson
;; Version: 1.17
;; Keywords: fontification of compilation buffer

;;; Commentary:

;; This file is not part of GNU Emacs.

;;; m4_limitation_of_warranty

;;; m4_install_instructions(d-comp)

;;; Known Bugs:

;; none

;;; Code:

(safe-require 'd-time)

(defvar compilation-start-time nil)

(defun d-comp--show-diffs ()
  (interactive)
  (setq font-lock-keywords nil)
  (setq font-lock-string-face nil)

  (d-font-lock-add-end
   '(

     ("^[a-zA-Z].*$" . 'bg:red);; for diff outputs...
     ("^[!>].*$" 0 'font-lock-comment-face t)
     ("^<.*$" 0 'default t)

     ))
  (font-lock-fontify-buffer)
  ;;  (font-lock-mode 0)
  ;;  (font-lock-mode 1)
  )

;;(add-hook 'compilation-mode-hook 'd-compilation-mode-hook)
;;(add-hook 'compilation-mode-hook 'd-foo)

(setq compilation-finish-functions (cons 'd-compilation-finish-function compilation-finish-functions))
;;(setq compilation-finish-function 'd-compilation-finish-function)

(defun d-compilation-finish-function (buf msg)
  (setq compilation-stop-time (current-time))
  (d-compilation-mode-hook)
  (save-excursion
    (set-buffer buf)
    (goto-char (point-max))
    (insert "Compilation took " (seconds-to-readable-string
                                 (seconds-of-time-difference compilation-start-time
                                                             compilation-stop-time))))

  (if (fboundp 'd-speedbar)
      (d-speedbar))

  (d-quote let ((f "d:/sound-samples/archive-wav/beep_laughing_warning.wav"))
    (if (file-exists-p f)
        (play-sound (list 'sound :file f :volume 1.0))
      (beep)))

  (d-quote if prefs-home-emacs-p
      (save-excursion
        (goto-char (point-min))
        (if (re-search-forward "[^:][Ee]rror" nil t)
            )))
  )

(d-quote (/ 0 0) 1 2 3)
(d-quote 1 2 3)
(d-quote defun was-error ()
  ;;(debug)
  (if emacs-dialect--dosemacs-p
      (let ((case-fold-search t))
        (cond
         ((save-excursion
            (goto-char 1)
            (re-search-forward "Exiting due to signal SIGINT" nil t))
          nil)
         ((save-excursion
            (goto-char 1)
            (re-search-forward "Exiting due to signal SIGSEGV" nil t))
          (play-sound (list 'sound :file (format "%s/sound-samples/archive-wav/wheee.wav" drive-f) :volume 1.0))
          ;;(shell-command "playwav d:/home/sounds/upset.wav")
          t)
         ((save-excursion
            (goto-char 1)
            (re-search-forward "assertion failed" nil t))
          (play-sound (list 'sound :file (format "%s/sound-samples/archive-wav/warning.wav" drive-f) :volume 1.0))
          t)
         ((save-excursion
            (goto-char 1)
            (re-search-forward (concat "\\(abnormally\\|"
                                       "[^W:][Ee]rror\\|"
                                       "failed\\|"
                                       "ENOENT\\|"
                                       "\\*\\*\\*\\)") nil 't))
          ;;          (shell-command "43")
          (play-sound (list 'sound :file (format "%s/sound-samples/archive-wav/ploop.wav" drive-f) :volume 1.0))
          ;;(shell-command "playwav -v 255 d:/home/sounds/ploop.wav")
          t)
         ((save-excursion
            (goto-char 1)
            (re-search-forward "warning" nil 'NOERROR))
          (let ((visible-bell nil))
            (beep 1)
            (message "*** detected a warning! ***")
            (sit-for 1))
          t))
        )
    )
  )

(defun was-bye-bye ()
  (interactive)
  (save-excursion
    (goto-line 1)
    (if (re-search-forward "bye bye!" nil t)
        (message "!!! was bye bye"))
    )
  )

(if emacs-dialect--dosemacs-p
    (defadvice compile-goto-error (before fix-crap activate)
      (if (not (eq 2 (count-windows)))
          (split-window-vertically))))

(global-set-key [f9] 'd-f9)
(global-set-key [(shift f9)]   'd-shift-f9)
;;;
;;; NOTE: the following command has been replaced by d-html--meta-f9
;;;
;;(global-set-key [(meta f9)]    'd-shift-f9)
(global-set-key [(control f9)] 'd-shift-f9)

(if (or (not 'compile-history)
        (not (boundp 'compile-history)))
    (setq compile-history '("make ")))

(add-hook 'compilation-mode-hook 'd-comp--record-current-time)
(defun d-comp--record-current-time ()
  (if (not (boundp 'patched-save-some-buffers-for-early-cst))
      (setq compilation-start-time (current-time)))
  )

(defun d-ask-are-you-sure ()
  "Uses dynamic scoping for the variable do-it"
  (progn
    ;;(if (string-match "\\<clean\\>" (car compile-history))
    ;;    (setq do-it (y-or-n-p "Are you sure you want to make clean? ")))
    (if (string-match "\\<depend\\>" (car compile-history))
        (setq do-it (y-or-n-p "Are you sure you want to make depend? ")))
    (if (string-match "\\<html-quote\\>" (car compile-history))
        (setq do-it (y-or-n-p "Are you sure you want to make html-quote? ")))
    (if (string-match "\\<publish\\>" (car compile-history))
        (setq do-it (y-or-n-p "Are you sure you want to make publish? ")))
    (if (string-match "\\<tar\\>" (car compile-history))
        (setq do-it (y-or-n-p "Are you sure you want to make tar? ")))
    )
  )

(d-quote defun d-set-first-second ()
  (let ((first  (car compile-history))
        (second (cadr compile-history)))
    (setq compile-history (d-kill-adjacent-duplicates compile-history))
    (setq compile-history (delete-duplicates compile-history :test 'string=))
    (setq compile-history (remove-duplicates compile-history :key nil))
    (setq compile-history (cons first compile-history))
    ;;(setq compile-history (cons first (cons second compile-history)))
    ))

(defun d-f9 ()
  (interactive)
  ;;(d-check-for-jtw-includes)
  ;;
  ;; NOTE: cool
  ;;
  (when (string-match (concat "^" (getenv "HOME") "/.greenfoot")
                      (expand-file-name default-directory))
    (dired (concat (getenv "HOME") "/.greenfoot/scenarios/HuntTheWumpus")))

  ;;(dired "c2java")
  (if (eq major-mode 'dired-mode)
      (setq default-directory dired-directory))
  (setq compile-history (d-kill-adjacent-duplicates compile-history))
  (safe-command (condition-case err
                    (progn
                      (kill-compilation)
                      (sit-for 2))
                  (error
                   )) 'QUIET)
  (sit-for 1)
  ;;(save-some-buffers 'NO-QUESTIONS)
  ;;(d-time--update-frame-title)
  (let ((do-it t))
    (d-ask-are-you-sure)
    (when do-it
      (compile (car compile-history))
      )
    ;;(d-set-first-second)
    ;;(d-time--update-frame-title)
    ))

(defun d-shift-f9 ()
  (interactive)
  ;;(d-walk-frames
  ;;(switch-to-buffer (d-speedbar--get-old-buffer (caar ptr-walk)))
  (if (fboundp 'd-groups-modeline-hook) (d-groups-modeline-hook))
  (delete-other-windows)
  (if (eq major-mode 'dired-mode)
      (setq default-directory dired-directory))
  ;;(d-check-for-jtw-includes)
  ;;(d-set-first-second)
  ;;(setq cur (car compile-history))
  ;;(setq compile-history (cdr compile-history))
  ;;(setcar compile-history (safe-expand-file-name (car compile-history)))
  (read-from-minibuffer "Compile command: " (car compile-history) nil nil 'compile-history)
  (let ((do-it t))
    (d-ask-are-you-sure)
    ;;(if (eq 1 (count-windows))
    ;;    (split-window-vertically))
    (when do-it
      ;;(delete-other-windows)
      ;;(save-some-buffers 'NO-QUESTIONS)
      ;;(d-time--update-frame-title)
      (if (fboundp 'd-groups-modeline-hook) (d-groups-modeline-hook))
      (compile (car compile-history))))
  ;;(setq compile-history (d-kill-adjacent-duplicates compile-history))
  ;;(d-time--update-frame-title)
  )

(defun do-shell-line ()
  (interactive)
  (shell-command
   (buffer-substring-no-properties
    (point-at-bol)
    (point-at-eol))))

(defadvice compilation-mode (around set-writeable activate)
  ;;(read-only-mode -1)
  ad-do-it
  (read-only-mode -1))

(add-hook 'compilation-mode-hook 'd-compilation-mode-hook)

(defun d-compilation-mode-hook ()
  (define-key compilation-mode-map [return] 'd-comp-enter)
  (setq truncate-lines nil)
  (font-lock-fontify-buffer)
  ;;(define-key compilation-mode-map [return] 'compile-goto-error)
  (progn
    (define-key compilation-mode-map [(shift prior)] 'backward-paragraph)
    (define-key compilation-mode-map [(shift next)]  'forward-paragraph)
    ))

;; (d-goto-column 23)
(defun d-goto-column (column)
  (interactive "nEnter column to go to:")
  (beginning-of-line)
  (while (and (< (current-column) column) (not (eolp)))
    (forward-char 1)))

;;; (setq str "Exception in thread \"main\" java.lang.AssertionError: r.debugInfo()=(symbol=(CHAR, '(' (integer 40)), location=(com/davinpearson/expr/Reader.cc:4:7)),data=r.currentToken()=40")
(defun d-comp-enter ()
  (interactive)
  (let (file line column str)
    (push-mark (point) 'no-msg)
    (setq str (d-trim-string (d-current-line-as-string)))
    (cond
     ;; --------------------------------------------------------------
     ((string-match "input[0-9]+: \\(red-line=\\)?\\([-a-zA-Z0-9_./]+\\):\\([0-9]+\\)" str)
      (setq file (substring str (match-beginning 2) (match-end 2)))
      (setq line (substring str (match-beginning 3) (match-end 3)))
      (setq line (read-str line))
      (if (file-exists-p file)
          (progn
            (find-file file)
            (goto-line line))
        (error "File %s does not exist" file)))
     ;; --------------------------------------------------------------
     ((string-match "at \\(\\([a-z]+\\.\\)*\\)\\([A-Z][a-zA-Z0-9_]*\\)\\.[a-z<][A-Za-z0-9_>]*(\\([A-Z][a-zA-Z0-9_]*\\.java\\):\\([0-9]+\\))" str)
     ;;((string-match "at \\(\\([a-z]+\\.\\)*\\)" str)
      (setq path (substring str (match-beginning 1) (match-end 1)))
      (setq file (substring str (match-beginning 4) (match-end 4)))
      (setq line (read-str (substring str (match-beginning 5) (match-end 5))))
      (while (string-match "\\." path)
        (setq path-pre  (substring path 0 (match-beginning 0)))
        (setq path-post (substring path (match-end 0)))
        (setq path (concat path-pre "/" path-post)))
      (setq file (concat default-directory path file))
      (if (file-exists-p file)
          (progn
            (find-file file)
            (goto-line line))
        (error "File %s does not exist" file)))
     ;; --------------------------------------------------------------
     ((string-match "^[ \t]*\\([a-zA-Z0-9/]*\\.\\([a-z+]+\\)\\):\\([0-9]+\\): error:" str)
      (setq file (concat default-directory (substring str (match-beginning 1) (match-end 1))))
      (setq line (read-str (substring str (match-beginning 3) (match-end 3))))
      (if (file-exists-p file)
          (progn
            (find-file file)
            (goto-line line))
        (error "File %s does not exist" file)))
     ;; --------------------------------------------------------------
     ((string-match "^\\([A-Z][a-zA-Z0-9_.]*\\.cs\\)(\\([0-9]+\\)):" str)
      ;;(d-foo)
      (setq file (substring str
                  (match-beginning 1)
                  (match-end 1)))
      (setq line (read-str (substring str
                            (match-beginning 2)
                            (match-end 2))))
      (if (file-exists-p file)
          (progn
            (find-file file)
            (goto-line line))
        (error "File %s does not exist" file)
        )
      )
     ;; --------------------------------------------------------------
     ((string-match "m4:\\(.*\\):\\([0-9]+\\)" str)
      (setq file (substring str (match-beginning 1) (match-end 1)))
      (setq line (read-str (substring str (match-beginning 2) (match-end 2))))
      (if (file-exists-p file)
          (progn
            (find-file file)
            (goto-line line))
        (error "File %s does not exist" file)))
     ;; --------------------------------------------------------------
     ((string-match "^/cygdrive/\\([a-z]\\)/\\([^ :]*\\):\\([0-9]*\\)" str)
      (setq drive (substring str (match-beginning 1) (match-end 1)))
      (setq file  (concat drive ":/" (substring str (match-beginning 2) (match-end 2))))
      (setq line  (read-str (substring str (match-beginning 3) (match-end 3))))
      ;;(debug "foo")
      (if (file-exists-p file)
          (progn
            (find-file file)
            (goto-line line))))
     ;; --------------------------------------------------------------
     ((string-match "^.*(\\([^ ]*\\(\\.[a-z+]+\\)*\\):\\([0-9]+\\):\\([0-9]+\\))" str)
      (setq file (concat default-directory (substring str (match-beginning 1) (match-end 1))))
      (setq line (read-str (substring str (match-beginning 3) (match-end 3))))
      (setq column (read-str (substring str (match-beginning 4) (match-end 4))))
      ;;(debug "foomatic")
      (if (file-exists-p file)
          (progn
            (find-file file)
            (goto-line line)
            (d-goto-column column))
        (error "File %s does not exist" file))
      )
     ;; --------------------------------------------------------------
     ((string-match "(\\([^ ]*\\.\\([a-z]+\\)\\):\\([0-9]+\\))" str)
      (setq file (substring str (match-beginning 1) (match-end 1)))
      (setq line (substring str (match-beginning 3) (match-end 3)))
      ;;(debug)
      (if (file-exists-p file)
          (progn
            (find-file file)
            (goto-line (read-str line)))
        (error "File %s does not exist" file)))
     ;; --------------------------------------------------------------
     ((string-match "\\(^[a-zA-Z]:[\\/][-a-zA-Z0-9_./\\+]*\\):\\([0-9]+\\):" str)
      (setq file (substring str (match-beginning 1) (match-end 1)))
      (setq line (substring str (match-beginning 2) (match-end 2)))
      ;;(debug)
      (find-file file)
      (goto-line (read-str line)))
     ;; --------------------------------------------------------------
     ((string-match "\\(^[-a-zA-Z0-9_./\\+]+\\):\\([0-9]+\\):" str)
      (setq file (substring str (match-beginning 1) (match-end 1)))
      (setq line (substring str (match-beginning 2) (match-end 2)))
      ;;(debug)
      (find-file file)
      (goto-line (read-str line)))
     ;; --------------------------------------------------------------
     ((string-match "from \\([-a-zA-Z0-9_./\\+]+\\):\\([0-9]+\\)[,:]" str)
      (setq file (substring str (match-beginning 1) (match-end 1)))
      (setq line (substring str (match-beginning 2) (match-end 2)))
      ;;(debug)
      (find-file file)
      (goto-line (read-str line)))
     ;; --------------------------------------------------------------
     ((string-match "(\\([a-zA-Z0-9_.]+\\):\\([0-9]+\\):\\([0-9]+\\))" str)
      (setq file   (substring str (match-beginning 1) (match-end 1)))
      (setq line   (substring str (match-beginning 2) (match-end 2)))
      (setq column (substring str (match-beginning 3) (match-end 3)))
      ;;(run-with-timer 0.1 nil 'd-comp-timer-function)
      ;;(debug "harry-potter")
      (progn
        (find-file file)
        ;;(sit-for 1)
        ;;(goto-char (point-min))
        (goto-line (read-str line))
        (d-goto-column (read-str column)))
      )
     ;; --------------------------------------------------------------
     (t
      (message "No (file:line) on this line"))
     )
    )
  )

(d-quote
 (defun d-comp-timer-function ()
   ;;(play-sound (list 'sound :file "c:/sound-samples/bubbles.wav" :volume 1.0))
   ;;(play-sound (list 'sound :file "/media/www/C80GB/sound-samples/bubbles.wav" :volume 1.0))
   (progn
     (find-file file)
     ;;(sit-for 1)
     (goto-char (point-min))
     (goto-line (read-str line))
     (d-goto-column (read-str column)))))

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