(eval-when-compile
(require 'balloon-help)
(require 'gnus-salt)
(require 'jde)
(require 'jde-checkstyle))
(require 'advice)
(defadvice make-face-italic (around nix-block-neep-make-face-italic activate compile)
"Avoid italicizing the Neep faces."
(unless (string-match "^Neep[^\w]" (font-name (face-font face locale tags exact-p)))
ad-do-it))
(defadvice make-face-bold-italic (around nix-block-neep-make-face-bold-italic activate compile)
"Avoid italicizing the Neep faces."
(unless (string-match "^Neep[^\w]" (font-name (face-font face locale tags exact-p)))
ad-do-it))
(add-hook 'font-lock-mode-hook 'turn-on-lazy-shot)
(setq lazy-shot-stealth-lines 50
lazy-shot-stealth-nice 0.5
lazy-shot-step-size 512)
(setq font-lock-maximum-size nil
try-oblique-before-italic-fonts t)
(defsubst set-face-properties (face props)
"Set lots of face properties at once.
PROPS is a list of pairs of (PROPERTY VALUE [LOCALE TAG-SET HOW-TO-ADD])."
(mapc #'(lambda (property) (apply 'set-face-property face property))
props)
nil)
(defsubst remove-face-properties (face props)
"Remove lots of face properties at once, ignoring errors.
PROPS is a list of pairs of (PROPERTY [LOCALE TAG-SET])."
(mapc #'(lambda (property) (apply 'remove-face-property face property))
props)
nil)
(defun face-at-point (&optional pos buffer)
"Return a list of faces being used at POS in BUFFER.
The most important is listed first.
By default, use `point' in the current buffer."
(let ((upper-face-extent
(extent-at (or pos (point buffer))
(or buffer (current-buffer))
'face)))
(if (not upper-face-extent) 'default
(extent-face upper-face-extent))))
(defun face-at-point-command (&optional pos buffer)
"Print the name of the face at POS in BUFFER at the bottom of the frame.
By default, use `point' in the current buffer."
(interactive)
(message "Face: %s" (face-at-point pos buffer)))
(setq font-lock-maximum-decoration t)
(make-face-italic 'font-lock-comment-face)
(make-face-unbold 'font-lock-comment-face)
(set-face-properties 'font-lock-comment-face '((foreground "grey45" nil x)
(dim t)
(underline nil)))
(make-face-unbold 'font-lock-doc-string-face)
(set-face-properties 'font-lock-doc-string-face '((foreground "steelblue1" nil x)
(highlight t)))
(make-face-unbold 'font-lock-string-face)
(set-face-properties 'font-lock-string-face '((foreground "PaleVioletRed" nil x)
(highlight t)))
(make-face-bold 'font-lock-function-name-face)
(set-face-properties 'font-lock-function-name-face '((foreground "white" nil x)
(highlight nil)
(underline nil)))
(make-face-bold 'font-lock-variable-name-face)
(set-face-properties 'font-lock-variable-name-face '((foreground "cyan" nil x)
(underline nil)))
(make-face-bold 'font-lock-keyword-face)
(set-face-properties 'font-lock-keyword-face '((foreground "white" nil x)
(highlight nil)
(underline nil)))
(make-face-italic 'font-lock-preprocessor-face)
(set-face-properties 'font-lock-preprocessor-face '((foreground "lightblue" nil x)
(underline nil)
(italic t)))
(set-face-properties 'font-lock-reference-face '((foreground "linen" nil x)
(highlight t tty)))
(set-face-foreground 'font-lock-type-face "lightsteelblue" nil 'x)
(set-face-properties 'zmacs-region '((foreground "Black")
(background "LightGreen" nil x)
(background "green" nil tty)))
(copy-face 'zmacs-region 'highlight) (copy-face 'zmacs-region 'primary-selection)
(copy-face 'primary-selection 'secondary-selection)
(set-face-properties 'secondary-selection '((background "darkolivegreen" nil x)
(dim t)))
(set-face-properties 'isearch '((background "dimgrey" nil x)
(background "grey" nil tty)))
(set-face-properties 'text-cursor '((background "white" nil x)))
(set-face-properties 'pointer '((foreground "Black" nil x)
(background "White" nil x)))
(set-face-properties 'list-mode-item-selected '((background "dodgerblue" nil x)))
(defun gawd-sanitize-ediff-faces ()
"Set the ediff faces to something legible on a dark background."
(set-face-properties 'ediff-even-diff-A '((foreground "White" nil x)
(background "Black" nil x)
(background-pixmap "dark-grey-marble.xpm")))
(copy-face 'ediff-even-diff-A 'ediff-even-diff-C)
(set-face-background-pixmap 'ediff-even-diff-C "dark-yellow-marble.xpm")
(set-face-properties 'ediff-even-diff-B '((foreground "LightSteelBlue" nil x)
(background "Black" nil x)
(background-pixmap "dark-purple-marble.xpm")))
(copy-face 'ediff-even-diff-B 'ediff-even-diff-Ancestor)
(copy-face 'ediff-even-diff-A 'ediff-odd-diff-A)
(set-face-background-pixmap 'ediff-odd-diff-A "really-dark-grey-marble.xpm")
(copy-face 'ediff-odd-diff-A 'ediff-odd-diff-C)
(set-face-background-pixmap 'ediff-odd-diff-C "really-dark-yellow-marble.xpm")
(copy-face 'ediff-even-diff-B 'ediff-odd-diff-B)
(set-face-background-pixmap 'ediff-odd-diff-B "really-dark-purple-marble.xpm")
(copy-face 'ediff-odd-diff-B 'ediff-odd-diff-Ancestor)
(set-face-properties 'ediff-fine-diff-A '((foreground "darkblue")
(background "navy")
(background-pixmap "grey-marble.xpm")))
(set-face-properties 'ediff-fine-diff-A '((foreground "darkblue")
(background "navy")
(background-pixmap "grey-marble.xpm")))
(set-face-properties 'ediff-fine-diff-B '((foreground "black")
(background "Yellow")
(background-pixmap "yellow-marble.xpm")))
(set-face-properties 'ediff-fine-diff-C '((foreground "yellow")
(background "skyblue")
(background-pixmap "purple-marble.xpm"))))
(add-hook 'ediff-load-hook 'gawd-sanitize-ediff-faces)
(defmacro gawd-sanitize-some-w3m-faces (face-pixmap-alist)
"Set the w3m faces to something sane.
The FACE-PIXMAP-ALIST is an alist mapping faces to pixmaps."
(list 'map nil #'(lambda (face pixmap)
(remove-face-properties face `((foreground nil x)
(background-pixmap nil x)))
(set-face-properties face `((foreground "black" nil x)
(underline nil x)
(background-pixmap ,pixmap nil x))))
(list 'quote (mapcar* 'car (eval face-pixmap-alist)))
(list 'quote (mapcar* 'cdr (eval face-pixmap-alist)))))
(defun gawd-sanitize-general-w3m-faces ()
"Set the general (non-forms) w3m faces to something sane.
Specifically, turn off (horrible-looking) underlining, and use a background
pixmap instead."
(gawd-sanitize-some-w3m-faces '((w3m-anchor-face . "yellow-marble.xpm")
(w3m-arrived-anchor-face . "dark-yellow-marble.xpm"))))
(defun gawd-sanitize-forms-w3m-faces ()
"Set the general (form-related) w3m faces to something sane.
Specifically, turn off (horrible-looking) underlining, and use a background
pixmap instead."
(gawd-sanitize-some-w3m-faces '((w3m-form-face . "purple-marble.xpm"))))
(add-hook 'w3m-load-hook 'gawd-sanitize-general-w3m-faces)
(add-hook 'w3m-forms-load-hook 'gawd-sanitize-forms-w3m-faces)
(defun gawd-sanitize-erc-faces ()
"Set the faces for the ERC client to something sane.
This is pretty much an inversion of the preexisting colours."
(set-face-properties 'erc-direct-msg-face '((foreground "hotpink" nil x)
(foreground "brightred" nil tty)))
(set-face-properties 'erc-highlight-face '((foreground "green" nil tty)))
(set-face-properties 'erc-host-danger-face '((foreground "magenta")))
(remove-face-property 'erc-input-face 'background)
(set-face-properties 'erc-input-face '((foreground "white" nil tty)))
(set-face-properties 'erc-inverse-face '((foreground "black")
(background "white")))
(make-face-unbold 'erc-notice-face)
(make-face-italic 'erc-notice-face)
(set-face-properties 'erc-notice-face '((foreground "lightsteelblue" nil x)
(foreground "blue" nil tty)))
(set-face-properties 'erc-pal-face '((foreground "antiquewhite" nil x)
(foreground "white" nil tty)))
(set-face-properties 'erc-prompt-face '((background "black")
(foreground "lightblue2" nil x)
(foreground "blue" nil tty)))
(set-face-background 'bg:erc-color-face0 "black")
(set-face-background 'bg:erc-color-face1 "White")
(set-face-background 'fg:erc-color-face0 "black")
(set-face-background 'fg:erc-color-face1 "White"))
(add-hook 'erc-load-hook 'gawd-sanitize-erc-faces)
(defun gawd-sanitize-message-faces ()
"Set the faces used in email responses to something sane."
(set-face-foreground 'message-cited-text "tan" nil 'x)
(set-face-foreground 'message-cited-text "brightred" nil 'tty))
(add-hook 'message-load-hook 'gawd-sanitize-message-faces)
(mapc #'(lambda (face) (set-face-background face "#102060" nil 'x))
(mapcan #'(lambda (face) (and (string-match "^modeline-?" (symbol-name face)) (list face))) (face-list)))
(setq vc-mode-face 'modeline-mousable)
(set-face-foreground 'modeline "chartreuse" nil 'x)
(set-face-foreground 'modeline-buffer-id "palegoldenrod" nil 'x)
(set-face-foreground 'modeline-mousable "burlywood" nil 'x)
(set-face-foreground 'modeline-mousable-minor-mode "lightseagreen" nil 'x)
(setq gnus-selected-tree-face 'isearch)
(set-specifier default-toolbar-visible-p nil)
(set-face-background 'buffers-tab "Black")
(make-face 'echo-area-face "Face used to display the echo area.")
(set-face-properties 'echo-area-face '((foreground "lightseagreen" nil x)
(foreground "brightgreen" nil tty)))
(save-excursion
(set-buffer " *Echo Area*")
(let ((echo-area-face-extent
(make-extent (point-min) (point-max))))
(set-extent-properties echo-area-face-extent '(end-open nil detachable nil))
(set-extent-face echo-area-face-extent 'echo-area-face)))
(setq balloon-help-foreground
(color-instance-name (face-property-instance 'echo-area-face 'foreground)))
(setq balloon-help-background
(color-instance-name (face-property-instance 'echo-area-face 'background)))
(setq balloon-help-background-pixmap "dark-purple-marble.xpm")
(setq balloon-help-border-color "mintcream")
(setq balloon-help-font "-adobe-new century schoolbook-medium-r-normal-*-*-120-*-*-p-*-iso-10646-1")
(copy-face 'default 'paren-match)
(make-face-bold 'paren-match)
(copy-face 'default 'paren-blink-off)
(set-face-properties 'paren-blink-off '((dim t nil x)
(background-pixmap "foo" nil tty)))
(provide 'gawd-faces)