(require 'cl)
(set-face-foreground 'default "white")
(set-face-background 'default "black")

(setq browse-url-generic-program "gnome-open")
(setq browse-url-browser-function #'browse-url-generic)

;(set-face-font 'default (make-font-specifier "-dejavu-dejavu sans mono-medium-r-normal-*-*-180-*-*-m-*-*-*"))
;(set-face-font 'bold (make-font-specifier "-dejavu-dejavu sans mono-bold-r-normal-*-*-180-*-*-m-*-*-*"))

;(set-face-font 'italic (make-font-specifier "-dejavu-dejavu sans mono-medium-o-normal-*-*-180-*-*-m-*-*-*"))
;(set-face-font 'bold-italic (make-font-specifier "-dejavu-dejavu sans mono-bold-o-normal-*-*-180-*-*-m-*-*-*"))

;;;; DEPENDENCIES
(setq load-path (append (list (concat (getenv "HOME") "/.elisp")
			      (concat (getenv "HOME") "/.xemacs")
			      "/usr/local/lib/xemacs/site-lisp"
			      "/usr/share/emacs/site-lisp/sawfish")
			load-path))

(require 'un-define)
(require 'gnus)
(require 'ibuffer)
(require 'sawfish)
(require 'utf)

;;;; FUNCTIONS

(defun replace-behind-point-regexp (FROM TO)
  "Replace the regexp FROM, if it appears behind point, with TO.
Returns the string replaced, or nil if nothing was replaced."
  (save-excursion
    (let
	((pt (point)))
      (and (re-search-backward FROM (point-min) t)
	   (= (match-end 0) pt)
	   (let
	       ((S (buffer-substring (match-beginning 0) (match-end 0))))
	     (replace-match TO)
	     S)))))

(defun replace-behind-point (FROM TO)
  "Replace the string FROM, if it appears behind point, with TO.
Returns the string replaced, or nil if nothing was replaced."
  (save-excursion
    (let
	((pt (point)))
      (and (search-backward FROM (point-min) t)
	   (= (match-end 0) pt)
	   (let
	       ((S (buffer-substring (match-beginning 0) (match-end 0))))
	     (replace-match TO nil t)
	     S)))))

(defun call-behind-regexp (RE NEWGEN)
  "Perform the function NEWGEN with point behind the first match of
the regexp RE."
  (save-excursion
    (let
	((pt (point)))
      (goto-char (point-min))
      (and (re-search-forward RE (point-max) t)
	   (match-beginning 0)
	   (goto-char (match-beginning 0))
	   (funcall NEWGEN)))))

(defun append-buffer-to-file (file)
  "Append the contents of this buffer to a file."
  (interactive "FAppend to file: ")
  (append-to-file (point-min) (point-max) file))

(defun append-string-to-file (string file)
  "Append a string to a file."
  (with-temp-buffer
    (insert string)
    (append-buffer-to-file file)))

(defun addurl (PARG &optional PT)
  "Add URL at PT to ~/public_html/urls.html using addurl, defaulting to link under (point)"
  (interactive "P\nd")
  (let* ((thisurl (url-get-url-at-point PT))
	 (arglist (cond ((consp PARG) (list "addurl" "*addurl*" "addurl" "-t" thisurl))
			(t            (list "addurl" "*addurl*" "addurl" thisurl)))))
    (princ thisurl)
    (when (not (null thisurl)) (apply #'start-process arglist))))

(defun describe-face-at-point (&optional PT)
  "Return face used at point."
  (interactive "d")
  (let ((F (get-char-property PT 'face)))
    (cond ((null F)    (princ "No face at point"))
	  ((symbolp F) (hyper-describe-face F))
	  ((listp F)   (mapc #'hyper-describe-face F))
	  (t           (error 'invalid-argument F)))))

(defun customize-face-at-point (&optional PT)
  "Customize face at point."
  (interactive "d")
  (let ((F (get-char-property PT 'face)))
    (cond ((null F)    (princ "No face at point"))
	  ((symbolp F) (customize-face F))
	  ((listp F)   (mapc #'customize-face F))
	  (t           (error 'invalid-argument F)))))

(defun customize-face-at-point (&optional PT)
  "Customize face used at point."
  (interactive "d")
  (let ((F (get-char-property PT 'face)))
    (if F (customize-face F) (princ "No face at point"))))

(defun cuecat (CATCODE)
  "Convert a :CueCat code to a string and insert at point"
  (interactive "sCueCat code: ")
  (insert
    (with-temp-buffer
      (insert CATCODE)
      ;; (call-process-region START END PROGRAM &optional DELETEP BUFFER DISPLAYP &rest ARGS)
      (call-process-region (point-min) (point-max) "cuecat" t t)
      (buffer-string))))

(defun join-backwards (x)
  "Join this line with the next.  With prefix arg, join this line with the
preceding."
  (interactive "p")
  (join-line (and (= x 1) 1)))


(defun pop-up-ducky (X)
  "Pop up a ducky"
  (interactive "*p")
  (dotimes (N X)
    (insert (concat "\n        ___\n"
		    "QUACK  /   \\\n"
		    "  \\  __|O  |\n"
		    "     \\__   \\        /|\n"
		    "        \\   \\______/ |\n"
		    "        /            |\n"
		    "        |         )  /\n"
		    "        |    ____/  /\n"
		    "         \\_________/\n\n"))))


;;;; CONFIGURATION

;;; global
(setq display-time-24hr-format t)

(set-coding-priority-list '(utf-8))
(set-coding-category-system 'utf-8 'utf-8)
(set-default-coding-systems 'utf-8)
(set-default-buffer-file-coding-system 'utf-8)

(set-specifier scrollbar-width 12)

(set-input-mode (car (current-input-mode))
		(nth 1 (current-input-mode)) 0)

(if (and (equal (device-type (frame-device)) 'x)
	 (not (string-match "^:" (device-connection (frame-device)))))
      (setq x-selection-strict-motif-ownership nil))


;;; C/C++/Java/Perl
(defun nfm-c-lineup-to-left (langelem)
  (save-excursion
    (let* ((relpos (cdr langelem))
	   (curcol (progn (goto-char relpos)
			  (current-column))))
      (- curcol))))

(defconst nfm-c-style
  '((c-tab-always-indent           . t)
    (c-comment-only-line-offset    . 0)
    (c-basic-offset . 8)
    (c-hanging-braces-alist        . ((substatement-open after)
				      (class-open after)
				      (inline-open after)
				      (brace-list-open)))
    (c-hanging-colons-alist        . ((member-init-intro before)
				      (inher-intro)
				      (case-label after)
				      (label after)
				      (access-label after)))
    (c-cleanup-list                . (scope-operator
				      defun-close-semi
				      brace-else-brace
				      brace-elseif-brace
				      list-close-comma))
    (c-offsets-alist               . ((arglist-close        . c-lineup-arglist)
				      (substatement-open    . 0)
				      (arglist-intro        . c-lineup-arglist-intro-after-paren)
				      (arglist-cont         . -)
				      (case-label           . *)
				      (label                . /)
				      (access-label         . /)
				      (inline-open          . 0)
				      (statement-case-intro . *)
				      (block-open           . 0)
				      (knr-argdecl-intro    . -)))
    (index-tabs-mode               . nil)
    (c-echo-syntactic-information-p . t)) "style for nfm")

(add-hook 'c-mode-common-hook
	  #'(lambda ()
	      (setq c-C++-access-key "\\<\\(\\(public\\|protected\\|private\\)\\([	]*slots\\)?\\|signals\\)\\>[ 	]*:")
	      (setq c-access-key "\\<\\(\\(public\\|protected\\|private\\)\\([	]*slots\\)?\\|signals\\)\\>[ 	]*:")
	      (c-add-style "nfm" nfm-c-style t)
	      (c-toggle-auto-hungry-state 1)
	      (define-key c-mode-map   '(hyper tab) #'c-indent-command)
	      (define-key c++-mode-map '(hyper tab) #'c-indent-command)
	      (define-key c-mode-map   'tab #'semantic-complete-analyze-and-replace)
	      (define-key c++-mode-map 'tab #'semantic-complete-analyze-and-replace)
	      (setq tab-width 8
		    indent-tabs-mode t)))

(setq cperl-indent-level 8
      perl-indent-level 8)

;;; HTML, XML, DTDs, etc

(define-abbrev-table 'dtd-mode-abbrev-table
  `(("el" "<!ELEMENT " nil 1)
    ("al" "<!ATTLIST " nil 1)
    ("pc" "#PCDATA" nil 1)
    ("ci" "CDATA #IMPLIED\n\t" nil 1)
    ("cr" "CDATA #REQUIRED\n\t" nil 1)
    ("ii" "ID #IMPLIED\n\t" nil 1)
    ("ir" "ID #REQUIRED\n\t" nil 1)
    ("em" "EMPTY>\n" nil 1)
  ))

;;; VM, mail, etc.
(setq vm-move-after-deleting t
      vm-move-after-killing  t
      vm-move-after-undeleting t
      vm-frame-per-completion nil
      vm-frame-per-composition nil
      vm-frame-per-edit nil
      vm-frame-per-summary nil
      vm-frame-per-folder nil
      vm-frame-per-folders-summary nil
      vm-frame-per-help nil
      vm-preview-lines nil
      vm-use-toolbar nil)


;;; Key bindings
(global-set-key "\C-s" #'isearch-forward-regexp)
(global-set-key "\C-\M-s" #'isearch-forward)
(global-set-key "\C-r" #'isearch-backward-regexp)
(global-set-key "\M-%" #'query-replace-regexp)
(global-set-key [(control x) m] #'vm-compose-mail)
(global-set-key [find] #'query-replace-regexp)
(global-set-key [scroll-lock] #'(lambda () (interactive)))
(global-set-key [select] nil)
(global-set-key [print] nil)
(global-set-key '(hyper %) #'query-replace)
(global-set-key '(hyper j) #'join-backwards)
(global-set-key '(hyper ,) #'manual-entry)
(global-set-key [insertchar] #'overwrite-mode)  
(global-set-key '(hyper a) #'addurl)
(global-set-key '(hyper n) #'gnus)
(global-set-key '(hyper i) #'ispell-buffer)
(global-set-key '(hyper c) #'compile)
(global-set-key '(hyper p) #'pwd)
(global-set-key '(hyper d) #'dictionary-search)
(global-set-key '(hyper t) #'transpose-lines)
(global-set-key '(hyper r) #'replace-regexp)
(global-set-key '(hyper e) #'(lambda () (interactive) (find-file "~/.xemacs/init.el")))
(global-set-key '(hyper y) #'(lambda () (interactive) (yank '(1))))
(global-set-key '(hyper /) #'eldoc-doc)
;(global-set-key '(hyper \;) #'slime)
(global-set-key '(hyper space) #'just-one-space)
(global-set-key '(hyper \') #'expand-abbrev)
(global-set-key '(meta space) #'dabbrev-expand)
(global-set-key '(meta f10) #'cuecat)


(define-key minibuffer-local-map [tab] 'comint-dynamic-complete)

(global-set-key '(control m) #'newline-and-indent)
(global-set-key [return]     #'newline-and-indent)
(global-set-key [home]       #'beginning-of-buffer)
(global-set-key [end]        #'end-of-buffer)
(global-set-key '(hyper s)   #'(lambda () (interactive) (find-file "~/.sawfish/rc")))
(global-set-key '(hyper m)   #'vm)


(defun read-debian-mail ()
  "Use M-x vm to view mail from Debian mailing lists"
  (interactive)
  (vm "~/Folders/debian"))

(defun read-sawfish-mail ()
  "Use M-x vm to view mail from Debian mailing lists"
  (interactive)
  (vm "~/Folders/sawfish"))

(defun read-spam-mail ()
  "Use M-x vm to view probable spam"
  (interactive)
  (vm "~/Folders/spam"))

(defun read-gccg-mail ()
  "Use M-x vm to view mail from GCCG mailing lists"
  (interactive)
  (vm "~/Folders/gccg"))


(global-set-key '(hyper b) #'read-debian-mail)
(global-set-key '(hyper g) #'read-gccg-mail)
(global-set-key '(hyper f) #'read-sawfish-mail)
;(global-set-key '(hyper v) #'read-spam-mail)

(global-set-key '(control button3)   #'popup-buffer-menu)
(global-set-key 'button4  #'(lambda () (interactive) (scroll-down 5)))
(global-set-key 'button5  #'(lambda () (interactive) (scroll-up 5)))
(global-set-key '(control button4)  #'scroll-down)
(global-set-key '(control button5)  #'scroll-up)
(global-set-key '(shift button4)   #'(lambda () (interactive) (scroll-down 1)))
(global-set-key '(shift button5)   #'(lambda () (interactive) (scroll-up 1)))
(global-set-key '(meta button2)    #'insert-selection)

;;; Gnus and email
(setq gnus-read-active-file nil
      gnus-nov-is-evil nil
      gnus-novice-user nil
      gnus-check-bogus-newsgroups nil
      gnus-visible-headers "^From:\\|^Newsgroups:\\|^Subject:\\|^Date:\\|^Followup-To:\\|^Reply-To:\\|^Organization:\\|^Summary:\\|^Keywords:\\|^To:\\|^Cc:\\|^Posted-To:\\|^Mail-Copies-To:\\|^Apparently-To:\\|^Gnus-Warning:\\|^Resent-\\|^X-Newsreader"
      gnus-signature-file nil
      mail-signature t
      mail-yank-ignored-headers ":"
      mail-yank-prefix "> "
      mail-self-blind nil  ; use a hook below instead
      gnus-user-from-line "\"Neil Moore\" <neil@s-z.org>"
      gnus-local-organization "The Penguin Conspiracy"
      user-mail-address "neil@cs.uky.edu"
      query-user-mail-address nil
      news-reply-header-hook #'(lambda () (insert news-reply-yank-from " schrieb: "))
      ; gnus-select-method '(nntp "netnews.insightbb.com") ; dead
      gnus-treat-display-smileys nil)

;; BCC self on all mail.  We don't use mail-self-blind because vm uses the
;; user-mail-address for that, but we want user-login-name instead.
(add-hook 'mail-setup-hook
	  #'(lambda ()
	      (save-excursion
		(goto-char (point-min))
		(search-forward mail-header-separator nil t)
		(beginning-of-line)
		(insert "Bcc: " (user-login-name) "\n"))))


;;; *roff
(defun nfm-nroff-hyphen (X)
  "Hyphen, en dash, and em dash"
  (interactive "*p")
  (dotimes (N X)
    (or (replace-behind-point "-" "\\(en")
	(replace-behind-point "\\(en" "\\(em")
	(insert "-"))))

(defun nfm-nroff-lquote (X)
  "Backtick and open quote"
  (interactive "*p")
  (dotimes (N X)
    (or (replace-behind-point "`" "\\(lq")
	(insert "`"))))

(defun nfm-nroff-rquote (X)
  "Apostrophe and close quote"
  (interactive "*p")
  (dotimes (N X)
    (or (replace-behind-point "\\(aq" "\\(rq")
	(insert "\\(aq"))))

(defun nfm-nroff-backspace (X)
  "Backspace, breaking up quotes and such"
  (interactive "*p")
  (dotimes (N X)
    (or (replace-behind-point "\\(em" "\\(en")
	(replace-behind-point "\\(en" "-")
	(replace-behind-point "\\(lq" "`")
	(replace-behind-point "\\(rq" "\\(aq")
	(replace-behind-point "\\(aq" "")
	(delete-backward-char 1))))

(load-library "nroff-mode")
(define-key nroff-mode-map "'"         #'nfm-nroff-rquote)
(define-key nroff-mode-map "`"         #'nfm-nroff-lquote)
(define-key nroff-mode-map "-"         #'nfm-nroff-hyphen)
(define-key nroff-mode-map [\backspace] #'nfm-nroff-backspace)
(define-key nroff-mode-map [\return]   #'electric-nroff-newline)
(define-key nroff-mode-map '(hyper \')  #'(lambda () "Insert real single quote" (interactive "*") (insert "\'")))
(define-key nroff-mode-map '(control return) "\n.pp\n.sz 12\n")

(add-hook 'nroff-mode-hook
	  #'(lambda ()
	      (electric-nroff-mode 1)
	      (auto-fill-mode)))


;;; TeX
(load-library "tex-mode")
;(load-library "whizzytex")
;(define-key tex-mode-map '(hyper w) #'whizzytex-mode)


;;; Lisp

(defun sawfish-describe-symbol-at-point ()
  "Describe the sawfish symbol at point"
  (interactive)
  (sawfish-describe-show (intern (thing-at-point 'symbol) (vector 0))))

(defun elisp-describe-symbol-at-point ()
  "Describe the variable or function at point"
  (interactive)
  (cond
   ((variable-at-point) (describe-variable (variable-at-point)))
   (t (describe-function (function-at-point)))))

;(add-hook 'lisp-mode-hook (lambda () (slime-mode t)))
;(add-hook 'inferior-lisp-mode-hook (lambda () (inferior-slime-mode t)))
;(define-key inferior-slime-mode-map   '(hyper tab) #'slime-complete-symbol)
;(define-key slime-mode-map            '(hyper tab) #'slime-complete-symbol)
;(define-key slime-repl-mode-map       '(hyper tab) #'slime-complete-symbol)

;; rebind tab to complete, H-tab to indent
(define-key emacs-lisp-mode-map       '(hyper tab) #'indent-for-tab-command)
(define-key lisp-interaction-mode-map '(hyper tab) #'indent-for-tab-command)
(define-key sawfish-mode-map          '(hyper tab) #'indent-for-tab-command)

(define-key emacs-lisp-mode-map       'tab #'lisp-complete-symbol)
(define-key lisp-interaction-mode-map 'tab #'lisp-complete-symbol)
(define-key sawfish-mode-map          'tab #'sawfish-complete-symbol)

(define-key emacs-lisp-mode-map '(control return)  #'elisp-describe-symbol-at-point)
(define-key lisp-interaction-mode-map '(control return)  #'elisp-describe-symbol-at-point)
(define-key sawfish-mode-map          '(control return)  #'sawfish-describe-symbol-at-point)

;; Get rid of stupid lisp-mode toolbar
(defun lee-hook ())


;;; Misc
(global-set-key "\C-cp" #'pop-up-ducky)
(iswitchb-default-keybindings)
(global-set-key "\C-x\C-b" #'ibuffer)
(setq gc-cons-threshold 4194304)
(load "compose-keys")


;;; File types and extensions

(defun sawfish-temp-buffer (buf)
  "For use as the value of `temp-buffer-show-function':
Sets the major mode to Help if the name of the buffer is \"*sawfish-help\".
Shows the temp buffer in the current frame regardless of the buffer name
(using `show-temp-buffer-in-current-frame')."
  (progn
    (if (string-equal (buffer-name buf) "*sawfish-help*")
	(with-current-buffer buf
	  (help-mode)))
    (show-temp-buffer-in-current-frame buf)))
(setq temp-buffer-show-function #'sawfish-temp-buffer)

(setq auto-mode-alist
      `(("\\.sql$"         . ,#'sql-mode)
	("\\.php$"         . ,#'html-mode)
	("sawfish/custom$" . ,#'sawfish-mode)
	("\\.java$"        . ,#'java-mode)
	("Folders/[^/]+$"  . ,#'vm-mode)
	,.auto-mode-alist))

(setq completion-ignored-extensions
      (nconc completion-ignored-extensions
	     (list ".pdf" ".aux" ".ps" ".cache")))

(when (string= (getenv "DISPLAY") ":0.0")
  (setq gnuserv-frame t)
  (gnuserv-start) t)