;;; dired-colours.el --- Adding syntax highlighting to dired buffers

;; Copyright (C) 2006-2013 Davin Pearson

;; Author/Maintainer: m4_davin_pearson
;; Keywords: Dired Colors Font Lock Syntax Highlighting
;; Version: 1.0

;;; Commentary:

;; This file is not part of GNU Emacs.

;; Note the prefix dc- stands for dired-colours and creates a namespace
;; for the code.

;;; m4_limitation_of_warranty

;;; m4_install_instructions(dired-colours)

;;; Known Bugs:

;; None!

;;; Code:

(require 'diagnose)

(progn
;;;
;;; Feel free to add to these lists for fontification of your favorite extensions.
;;;
  (defvar dc-files-list--archives     '("iso" "bz2" "gz" "jar" "rpm" "tar" "taz" "tgz" "torrent" "z" "zip" "oxt" "7z" "rar" "epub" "xz"))
  (defvar dc-files-list--graphics     '("bmp" "dvi" "eps" "fig" "gif" "ico" "iff"  "jpe?g" "obj" "pbm" "pcx" "pdf" "pgm" "mpe?g" "png" "pov" "ps" "tga" "tif" "xbm" "xcf"))
  (defvar dc-files-list--movies       '("avi" "mov" "mpe?g" "wmv" "mp4" "mkv"))
  (defvar dc-files-list--sounds       '("au" "flac" "mid" "mp3" "wav" "wma" "ogg" "m4a" "ape"))
  (defvar dc-files-list--binaries     '("a" "dat" "la" "lib"))
  (defvar dc-files-list--web          '("css" "xlsx?" "doc" "hlp" "html?" "m4" "odt" "rtf" "tex" "wiki" "chm" "texi" "texinfo" "tesinfo"))
  (defvar dc-files-list--unimportant  '("aux" "bak" "bbl" "blg" "class" "dvi" "elc" "log" "o" "res" "tmp" "out" "toc" "old[0-9]*"))
  (defvar dc-files-list--executable   '("bat" "dll" "exe" "lnk" "pif" "reg" "msi"))
  (defvar dc-files-list--sources      '("jtw" "h" "hh" "c" "cpp" "cc" "el" "hs" "java" "js" "php" "pov" "tex" "cs"))
  (defvar dc-files-list--text         '("manifest" "txt"))

  (defvar prefs-bg-black nil
    "Whether or not the background colour is black.")
  )

(defun d-fonts--init-dired-colours ()
;;;
;;; Feel free to change the colours of the items
;;;
  (make-face 'dired-directory)
  (set-face-foreground 'dired-directory (if prefs-bg-black "#88aaff" "#0000ff"))
  (make-face-bold 'dired-directory)

  (make-face 'dc-face-dired-executable)
  (set-face-foreground 'dc-face-dired-executable "#0c0")
  (make-face-bold 'dc-face-dired-executable)
  (make-face 'dc-face-dired-archives)
  (set-face-foreground 'dc-face-dired-archives (if prefs-bg-black "#f88" "#f00"))
  (make-face-bold 'dc-face-dired-archives)
  (make-face 'dc-face-dired-binaries)
  (set-face-foreground 'dc-face-dired-binaries "#844")
  (make-face-bold 'dc-face-dired-binaries)
  ;;(make-face 'dc-face-dired-fig)
  ;;(set-face-foreground 'dc-face-dired-fig "#0ff")
  ;;(make-face-bold 'dc-face-dired-fig)
  (make-face 'dc-face-dired-graphics)
  (set-face-foreground 'dc-face-dired-graphics "#f0f")
  (make-face-bold 'dc-face-dired-graphics)
  (make-face 'dc-face-dired-movies)
  (set-face-background 'dc-face-dired-movies "#f0f")
  (set-face-foreground 'dc-face-dired-movies "#fff")
  (make-face-bold 'dc-face-dired-movies)
  (setq dc-face-dired-movies 'dc-face-dired-movies)
  (make-face 'dc-face-dired-sounds)
  (set-face-foreground 'dc-face-dired-sounds "#830")
  (make-face-bold 'dc-face-dired-sounds)
  (make-face 'dc-face-dired-sources)
  (make-face-bold 'dc-face-dired-sources)
  (if prefs-bg-black
      (set-face-foreground 'dc-face-dired-sources "#fff"))
  (make-face 'dc-face-dired-web)
  (if prefs-bg-black
      (progn
        (set-face-foreground 'dc-face-dired-web "#ffff00")
        (set-face-background 'dc-face-dired-web bg-colour))
    (set-face-background 'dc-face-dired-web "#ffff00")
    (set-face-foreground 'dc-face-dired-web "#000000"))
  (make-face-bold 'dc-face-dired-web)
  (make-face 'dc-face-dired-unimportant)
  (set-face-foreground 'dc-face-dired-unimportant "#888")
  ;;(make-face 'dc-face-dired-unimportant)
  (make-face 'dc-face-dired-text)
  ;;(set-face-foreground 'dc-face-dired-unimportant (if prefs-bg-black "#888" "#aaa"))

  (make-face 'fg:lightblue)
  (set-face-foreground 'fg:lightblue "#4455ff")

  (copy-face 'fg:lightblue 'dc-face-directory)
  (copy-face 'fg:lightblue 'dired-directory-face)
  (copy-face 'fg:lightblue 'dired-directory)
  (progn
    (make-face 'dired-marked)
    (set-face-background 'dired-marked "#7788ff")
    (set-face-foreground 'dired-marked "#ffffff")
    (make-face 'dired-flagged)
    (set-face-background 'dired-flagged "#ff5544")
    (set-face-foreground 'dired-flagged "#ffffff"))
  )

(d-fonts--init-dired-colours)

;;(copy-face 'bg:yellow               'dc-face-directory)
;;(copy-face 'fg:lightgreen           'dc-face-dired-executable)
;;(copy-face 'fg:lightred             'dc-face-dired-archives)
;;(copy-face 'fg:brown                'dc-face-dired-binaries)
;;(copy-face 'fg:lightcyan            'dc-face-dired-fig)
;;(copy-face 'fg:lightmagenta         'dc-face-dired-graphics)
;;(copy-face 'bg:lightmagenta         'dc-face-dired-movies)
;;(copy-face 'fg:brown                'dc-face-dired-sounds)
;;(copy-face 'fg:yellow               'dc-face-dired-web)
;;(copy-face 'fg:darkgray             'dc-face-dired-unimportant)
;;(make-face 'dc-face-dired-text)

(copy-face 'dc-face-dired-executable 'eshell-ls-product-face)

(require 'cl)

(setq emacs-dialect--xemacs-p (and (boundp 'xemacsp) (if (string-match "/usr/share/xemacs-" (car (last load-path))) t)))
(setq emacs-dialect--gnuemacs-p (not emacs-dialect--xemacs-p))
(setq emacs-dialect--dosemacs-p (if (string-match "msdos" (emacs-version)) t))
(setq os-type--msdos-p (if emacs-dialect--dosemacs-p t))
(setq os-type--linux-p (if (string-match "\\(redhat\\|komainu\\|toyol\\)" emacs-build-system) t))

(defun dc-dired-file-column ()
  0)

(d-quote
  (+ 49
     (max 8 (length user-login-name))
     (if os-type--msdos-p 4 0)
     )
  )

(defun dired-colours--hook ()
  (interactive)

  (setq font-lock-keywords nil)

  (setq dc-files-regexp--archives    (dc-dired--make-choice-regexp dc-files-list--archives))
  (setq dc-files-regexp--graphics    (dc-dired--make-choice-regexp dc-files-list--graphics))
  (setq dc-files-regexp--movies      (dc-dired--make-choice-regexp dc-files-list--movies))
  (setq dc-files-regexp--sounds      (dc-dired--make-choice-regexp dc-files-list--sounds))
  (setq dc-files-regexp--binaries    (dc-dired--make-choice-regexp dc-files-list--binaries))
  (setq dc-files-regexp--web         (dc-dired--make-choice-regexp dc-files-list--web))
  (setq dc-files-regexp--unimportant (dc-dired--make-choice-regexp dc-files-list--unimportant))
  (setq dc-files-regexp--executable  (dc-dired--make-choice-regexp dc-files-list--executable))
  (setq dc-files-regexp--sources     (dc-dired--make-choice-regexp dc-files-list--sources))
  (setq dc-files-regexp--text        (dc-dired--make-choice-regexp dc-files-list--text))

  (when emacs-dialect--gnuemacs-p
    ;;(d-foo)
    (setq dired-omit-files (concat "\\("
                                   "^_.*$\\|"
                                   "^\\..*$\\|"
                                   "^.*~$\\|"
                                   "^#.*#\\|"
                                   "^.*\\." dc-files-regexp--unimportant
                                   "$\\)"))
    )

  (when emacs-dialect--xemacs-p
    (setq dired-omit-extensions (mapcar (function (lambda (extension) (concat "." extension))) dc-files-list--unimportant))
    (setq dired-omit-regexps '("^_.*$" "^\\..*$"  "^.*~$" "^#.*#$"))
    (setq dired-re-raw-boring "^$")
    )

  (if os-type--linux-p
      (setq dc-dired--dotstring (make-string 12 ?.))
    (setq dc-dired--dotstring (make-string (dc-dired-file-column) ?.)))

  (assert (eq major-mode 'dired-mode))

  (d-font-lock-add-end (list
                          ;; ONLY WINDOWS:
                          '("^  \\([a-zA-Z]:.+:\\)$" (1 'dired-directory))
                          ;; ONLY LINUX:
                          '("^  \\(/.+:\\)$"         (1 'dired-directory))
                          ;; BOTH:
                          ;;'("^  \\(total.*\\)$" (1 'fg:white))

                          ;;(list "^ [ld].*$" 0 'dc-face-directory)

                          (list (concat "^" dc-dired--dotstring "\\(.*\\." dc-files-regexp--text "\\)[\n\r]")
                                1 ''dc-face-dired-text t)

                          (list (concat "^" dc-dired--dotstring "\\(.*\\." dc-files-regexp--executable "\\)[\n\r]")
                                1 ''dc-face-dired-executable t)

                          (list (concat "^" dc-dired--dotstring "\\(.*\\." dc-files-regexp--archives "\\)[\n\r]")
                                1 ''dc-face-dired-archives t)

                          (list (concat "^" dc-dired--dotstring "\\(.*\\." dc-files-regexp--graphics "\\)[\n\r]")
                                1 ''dc-face-dired-graphics t)

                          (list (concat "^" dc-dired--dotstring "\\(.*\\." dc-files-regexp--movies "\\)$")
                                1 ''dc-face-dired-movies t)

                          (list (concat "^" dc-dired--dotstring "\\(.*\\." dc-files-regexp--sounds "\\)[\n\r]")
                                1 ''dc-face-dired-sounds t)

                          (list (concat "^" dc-dired--dotstring "\\(.*\\." dc-files-regexp--binaries "\\)[\n\r]")
                                1 ''dc-face-dired-binaries t)

                          ;;(list (concat "^" dc-dired--dotstring "\\(.*\\." dc-files-regexp--fig "\\)[\n\r]")
                          ;;      1 ''dc-face-dired-fig t)

                          (list (concat "^" dc-dired--dotstring "\\(Makefile\\)[\n\r]")
                                1 ''dc-face-dired-sources t)

                          (list (concat "^" dc-dired--dotstring "\\(.*\\." dc-files-regexp--sources "\\)[\n\r]")
                                1 ''dc-face-dired-sources t)

                          (list (concat "^" dc-dired--dotstring "\\(.*\\." dc-files-regexp--web "\\)[\n\r]")
                                1 ''dc-face-dired-web t)

                          (list (concat "^" dc-dired--dotstring "\\(.*\\." dc-files-regexp--unimportant "\\)$")
                                1 ''dc-face-dired-unimportant t)

                          ;;(list (concat "^" dc-dired--dotstring "\\(_.*\\|\\..*\\|.*~\\|#.*#\\)$")
                          ;;    1 ''dc-face-dired-unimportant t)
                          )
                       )

  (when (or (string-match "/jtw-tutorials-here/"     default-directory)
            (string-match "~/jtw-tutorials/"         default-directory)
            (string-match "/home/www/jtw-tutorials/" default-directory))
    (d-font-lock-add-end '(
                           ("[ ][^ ]*\\.java$"             0 'dc-face-dired-unimportant t)
                           ("[ ]Makefile$"                 0 'dc-face-dired-graphics t)
                           ("[ ].*\\.el$"                  0 'dc-face-dired-graphics t)
                           ("[ ]TAGS$"                     0 'dc-face-dired-unimportant t)
                           )))

  (when (string-match "hairy-lemon/src/50webs-com/J\\.T\\.W/davins-jtw-tutorials/" default-directory)
    (d-font-lock-add-end '(
                             ("[ ]texinfo\\.tex$"            0 'dc-face-dired-graphics t)
                             ("[ ]m4\\.m4$"                  0 'dc-face-dired-graphics t)
                             ("[ ]Makefile$"                 0 'dc-face-dired-graphics t)
                             )))

  (d-font-lock-add-end `(
                           (,(concat "^\\(..d........." dc-dired--dotstring ".*$\\)") 1 'dired-directory t)
                           ("^\\*.*$"    0 'dired-marked  t)
                           ("^D.*$"      0 'dired-flagged t)
                           (".* \\-> .*" 0 'fg:lightred t)
                           ;;("root" 0 'bg:yellow t)
                           ))

  ;;(font-lock-mode nil)
  (font-lock-mode 1)
  )

(add-hook 'dired-mode-hook 'dired-colours--hook 'APPEND)
;;(add-hook 'dired-after-readin-hook  'dired-colours--hook)
;;(add-hook 'dired-before-readin-hook 'dired-colours--hook)

;; dired-mode-hook
;;(remove-hook 'dired-mode-hook 'd-gfxhook)
;;(remove-hook 'dired-mode-hook 'dired-colours--hook)
;;(add-hook 'dired-mode-hook 'dc-gfx-hook 'APPEND)

;; (dc-dired--make-choice-regexp (setq suffix-list '("zip" "jar" "tar" "rpm" "bz2" "gz" "z" "tgz" "taz")))
(defun dc-dired--make-choice-regexp (suffix-list)
  (let ((answer nil)
        (n 0))
    (setq answer "\\(")
    (while suffix-list
        (setq answer (concat answer (if (eq n 0) "" "\\|") (car suffix-list)))
        (incf n)
        (setq suffix-list (cdr suffix-list)))
    (setq answer (concat answer "\\)$"))))

(provide 'dired-colours)
;;; dired-colours.el ends here
