d-comp.el

    

;;; 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: Davin Max Pearson <http://davin.50webs.com>
;; Version: 1.17
;; Keywords: syntax highlighting of compilation buffer

;;; Commentary:

;; This file is not part of GNU Emacs.

;;; Limitation of Warranty

;; 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 detail.
;;
;; You should have received a copy of the GNU General Public License
;; along with GNU Emacs, see the file COPYING.  If not, see:
;;
;; <http://www.gnu.org/licenses/gpl-3.0.txt>.


;;; Install Instructions:
;; See the following URL for the latest info and a tarball:
;;
;; <http://davin.50webs.com/research/2010/mopa2e2.html#d-comp>
;;
;; Then untar the tarball to a folder pointed to by the Emacs variable
;; load-path and add the following line to your ~/.emacs file.
;;
;; (require '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)
  )

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

(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 started at: " (d-time--print-full-date-as-YYYYmmdd-HHMMSS compilation-start-time) "\n")
   (insert "Compilation stopped at: " (d-time--print-full-date-as-YYYYmmdd-HHMMSS compilation-stop-time)  "\n")
   (insert "Compilation took " (d-seconds-to-readable-string
                                (d-seconds-of-time-difference compilation-start-time
                                                              compilation-stop-time)) "\n"))

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

(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 ()
   (setq compilation-start-time (current-time)))

(defun d-ask-are-you-sure ()
  "Uses dynamic scoping for the variable do-it"
  (progn
    (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? ")))
    )
  )

(defun d-f9 ()
   (interactive)
   ;;
   ;; 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)
  (progn
   ;;(d-walk-frames
   ;;(switch-to-buffer (d-speedbar--get-old-buffer (caar ptr-walk)))
   (let (d-123)
     (if (fboundp 'd-groups-modeline-hook) (d-groups-modeline-hook))
     (delete-other-windows)
     (if (eq major-mode 'dired-mode)
         (setq d-123 dired-directory)
       (setq d-123 default-directory))
     (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))
         (dired d-123)
         (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))))

;; put back: see if it barfs
(defadvice compilation-mode (around d-compilation-mode activate)
 ;;(require 'autogc)
 (let (e)
   (setq ptr (buffer-list))
   ;;(make-local-variable 'e)
   (while ptr
     (set-buffer (car ptr))
     (when (buffer-file-name (car ptr))
       (setq e (warn--are-we-editing-p (buffer-file-name (car ptr))))
       (find-file (buffer-file-name (car ptr)))
       (goto-char (point-min))
       (while (re-search-forward "^[a-z];" nil t)
         (d-error "Error: Found \"^[a-z];\" in file %s" (buffer-file-name (car ptr)))
         )
       (goto-char (point-min))
       (while (re-search-forward "^s(" nil t)
         (d-error "Error: Found \"^[a-z](\" in file %s" (buffer-file-name (car ptr)))
         ))
     (if (not e) (kill-buffer nil))
     (setq ptr (cdr ptr))
     )
   ad-do-it
   (read-only-mode -1)))
;; end defadvice: compilation-mode

(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)
    ))

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

;; (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 (d-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 (d-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 (d-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 (d-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 (d-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  (d-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 (d-read-str (substring str (match-beginning 3) (match-end 3))))
      (setq column (d-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 (d-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 (d-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 (d-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 (d-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 (d-read-str line))
        (d-goto-column (d-read-str column)))
      )
     ;; --------------------------------------------------------------
     (t
      (message "No (file:line) on this line"))
     )))
;; end defun: d-comp-enter

(provide 'd-comp)