(setq debug-on-error nil)

(when (featurep 'mule)
  (set-language-environment "Latin-1")
  (unless (or (coding-system-p (find-coding-system 'utf-8))
              (null (locate-library "un-define")))
    (require 'un-define)
    (require 'unidata)))

; (setq load-path
;       (cons (expand-file-name "~/cool-stuff/gnus.cvs/lisp")
;           load-path))

;; compressed files
;; ################
(require 'jka-compr)
(toggle-auto-compression t t)

;; version control
;; ###############
(require 'vc)
(require 'vc-hooks)

;; font lock mode
;; ##############
(turn-on-font-lock)

;; show hostname in window title
;; #############################
(if (featurep 'xemacs)
    (setq frame-title-format (concat "%S on " (system-name) ": %b")))

;; figure out where we are running
;; ###############################
(defun run-on-albertp ()
  (or (string-match "^albert" (system-name))
      (string-match "^Vigor" (system-name))))

(defun run-on-steviep ()
  (string-match "^stevie" (system-name)))

(defconst insecure-wsi-clients
  '("midgard" "jimi" "rosencrantz" "robinson"))

(defun ek-all-but-last (l)
  (if (null (cdr l))
      '()
    (cons (car l) (ek-all-but-last (cdr l)))))

(defun run-on-insecure-client ()
  (let* ((last (nth (- (length insecure-wsi-clients) 1)
                    insecure-wsi-clients))
         (begin (ek-all-but-last insecure-wsi-clients))
         (regexp (concat
                  (apply 'concat
                         (mapcar (lambda (x) (concat "^" x "\\|"))
                                 begin))
                  "^" last)))
    (string-match regexp (system-name))))

(defun run-on-home-machinep ()
  (or (run-on-steviep) (run-on-albertp)))

(defun run-on-wsi-machinep ()
  (not (run-on-home-machinep)))

(defun is-macosx-machine ()
  (let ((uname
         (lambda ()
           (with-temp-buffer
             (let ((temp-buffer-name (buffer-name)))
               (let ((status
                      (apply 'call-process-region
                             (point-min) (point-max)
                             "uname"
                             nil temp-buffer-name nil)))
                 (if (zerop status)
                     (replace-in-string (buffer-string) "\n" ""))))))))
    (let ((os-name (funcall uname)))
      (and os-name (string-equal "Darwin" os-name)))))

;; load some modes
;; ###############
(defun filter-for (string list)
  (if (null list)
      nil
    (if (string-match string (car list))
        (filter-for string (cdr list))
      (cons (car list) (filter-for string (cdr list))))))

(let ((ejk-lisp-dir (expand-file-name "~/.xemacs/lisp")))
  
  (if (file-accessible-directory-p ejk-lisp-dir)
      (progn 
        (setq load-path (cons ejk-lisp-dir load-path))
        (require 'find-dired)
        (require 'face-list)
        (require 'scheme-tools)

        (autoload 'paredit-mode "paredit"
          "Minor mode for pseudo-structurally editing Lisp code."
          t)

        (autoload 'svk-status "psvk"
          "Major mode for svk version control."
          t))))

;; don't show buffer tabs
;; ######################
(if (and 
     (featurep 'xemacs)
     (>= emacs-major-version 21)
     (>= emacs-minor-version 2))
    (progn
      (set-specifier top-gutter-visible-p nil)
      (setq toolbar-visible-p nil
            progress-feedback-use-echo-area t)
      (set-specifier default-toolbar-visible-p nil)))

;; hilft das was?
(setq font-menu-this-frame-only-p nil)

;; TeX stuff
;; #########
(require 'tex-site)
(require 'filladapt)

(add-hook 'LaTeX-mode-hook 'turn-on-reftex)   ; with AUCTeX LaTeX mode
(add-hook 'latex-mode-hook 'turn-on-reftex)   ; with Emacs latex mode

(add-hook 'text-mode-hook 'turn-on-auto-fill)
(add-hook 'text-mode-hook 'turn-on-filladapt-mode)

;; starting www browser
;; ####################

(defun browse-url-osx-default-browser (url &optional new-window)
  "Open URL with system's default browser"
  (interactive (browse-url-interactive-arg "URL: "))
  (let ((osascript (executable-find "osascript"))
        (script (concat "open location \"" url "\"")))
    (start-process 
     (concat "OS X default browser: " url)
     nil
     osascript (concat "-e " script))))

(setq browse-url-browser-function
      (cond 
       ((is-macosx-machine) 'browse-url-osx-default-browser)
       ((eq window-system 'x) 'browse-url-netscape)
       (t 'browse-url-w3)))

(autoload browse-url-browser-function "browse-url"
  "Ask a WWW browser to show a URL." t)

;; Info files
;; ##########
(let ((home-info-dir (expand-file-name "~/.xemacs/info")))
  (if (file-accessible-directory-p home-info-dir)
      (setq Info-directory-list (cons home-info-dir Info-directory-list))))

;; Misc stuff
;; ##########

(require 'point-stack)
(global-set-key "\C-cm" 'point-stack-push)
(global-set-key "\C-cb" 'point-stack-pop)

(setq minibuffer-confirm-incomplete t)

(setq user-full-name "Eric Knauel")

(setq message-kill-buffer-on-exit t)

(setq focus-follows-mouse t)

(setq next-line-add-newlines nil
      display-time-24hr-format t
      column-number-mode t
      line-number-mode t)

(global-unset-key [backspace])
(global-set-key [backspace] 'delete-backward-char)
(global-unset-key [delete])
(global-set-key [delete] 'delete-char)

(add-hook 'c-mode-common-hook 
          '(lambda ()
             (setq c-basic-offset 2)))

(require 'uniquify)
(setq ediff-window-setup-function (quote ediff-setup-windows-plain)
      uniquify-buffer-name-style (quote post-forward)
      uniquify-after-kill-buffer-p t)

(global-set-key "\M-#" 'dabbrev-expand)

;; cut to register
(defun cut-to-register (register start end &optional noise)
  (interactive "cCut to register: \nr\nP")
  (if (string-match "c" (string register))
      (progn
        (message "Copying selection also to clipboard")
        (copy-primary-selection)))
  (copy-to-register register start end t))

(define-key global-map "\C-xc" 'cut-to-register)

(setq passwd-invert-frame-when-keyboard-grabbed nil)

(require 'boxquote)
(require 'redo)

(autoload 'resize-minibuffer-mode "rsz-minibuf" nil t)
(resize-minibuffer-mode)

(require 'func-menu)
(define-key global-map "\C-cf" 'fume-list-functions)
(define-key global-map "\C-cg" 'fume-prompt-function-goto)

(add-hook 'find-file-hooks 'fume-add-menubar-entry)

;; BBDB
;; ####
(setq bbdb-file "~/.bbdb")
(setq bbdb-default-area-code "07071")
(setq bbdb-north-american-phone-numbers-p nil)
(setq bbdb-electric-p nil)
(setq bbdb/mail-auto-create-p nil)
(setq bbdb/news-auto-create-p nil)
(setq bbdb-completion-display-record nil)
(setq bbdb-use-pop-up nil)

;; Printing
;; ########

;; Scheme mode
;; ###########
(autoload 'run-scheme "cmuscheme" "Run an inferior Scheme process." t)
(require 'cmuscheme48)

(add-hook 'inferior-scheme-mode-hook
          'turn-on-font-lock)

(setq scheme-program-name "scheme48")

(put 'case-returned-via 'scheme-indent-function 1)
(put 'class 'scheme-indent-function 2)
(put 'class* 'scheme-indent-function 3)
(put 'class-asi 'scheme-indent-function 1)
(put 'compound-unit/sig 'scheme-indent-function 1)
(put 'define-interface 'scheme-indent-function 1)
(put 'define-structure 'scheme-indent-function 2)
(put 'destructure 'scheme-indent-function 1)
(put 'do-job-once 'scheme-indent-function 2)
(put 'import-lambda-definition 'scheme-indent-function 1)
(put 'interface 'scheme-indent-function 1)
(put 'let-fluid 'scheme-indent-function 2)
(put 'let*-values 'scheme-indent-function 1)
(put 'let-optionals 'scheme-indent-function 2)
(put 'let-optionals* 'scheme-indent-function 2)
(put 'let-struct 'scheme-indent-function 2)
(put 'let-syntax 'scheme-indent-function 1)
(put 'let-values 'scheme-indent-function 1)
(put 'let/ec 'scheme-indent-function 1)
(put 'letrec-syntax 'scheme-indent-function 1)
(put 'letrec-values 'scheme-indent-function 1)
(put 'match-let 'scheme-indent-function 1)
(put 'match-let* 'scheme-indent-function 1)
(put 'match-letrec 'scheme-indent-function 1)
(put 'mixin 'scheme-indent-function 3)
(put 'mixin 'scheme-indent-function 3)
(put 'module 'scheme-indent-function 2)
(put 'opt-lambda 'scheme-indent-function 1)
(put 'parameterize 'scheme-indent-function 1)
(put 'receive 'scheme-indent-function 2)
(put 'switch 'scheme-indent-function 2)
(put 'syntax-case 'scheme-indent-function 2)
(put 'syntax-rules 'scheme-indent-function 1)
(put 'unit/sig 'scheme-indent-function 2)
(put 'unless 'scheme-indent-function 1)
(put 'variant-case 'scheme-indent-function 1)
(put 'when 'scheme-indent-function 1)
(put 'with-colored-background 'scheme-indent-function 1)
(put 'with-current-input-port 'scheme-indent-function 2)
(put 'with-current-output-port 'scheme-indent-function 1)
(put 'with-cwd 'scheme-indent-function 1)
(put 'with-dot-lock 'scheme-indent-function 1)
(put 'with-env 'scheme-indent-function 2)
(put 'with-error-output-port 'scheme-indent-function 2)
(put 'with-handlers 'scheme-indent-function 1)
(put 'with-lock 'scheme-indent-function 1)
(put 'with-new-proposal 'scheme-indent-function 2)
(put 'with-parameterization 'scheme-indent-function 2)
(put 'with-semaphore 'scheme-indent-function 1)
(put 'with-syntax 'scheme-indent-function 1)
(put 'with-tag 'scheme-indent-function 3)

(defun find-misbalanced-parentheses ()
  "Finds the first sexp in the current buffer with misbalanced parentheses"
  (interactive)
  (let ((current-point (point)))
    (goto-char 1)
    (let ((maybe-wrong-point (contains-misbalanced-parentheses?)))
      (if maybe-wrong-point
          (goto-char maybe-wrong-point)
        (progn
          (message "Buffer is okay")
          (goto-char current-point))))))

;;; return nil if buffer is okay, failing point otherwise
(defun contains-misbalanced-parentheses? ()
  (let ((current-point (point)))
    (if (< current-point (buffer-size))
        (let ((next-point (scan-sexps current-point 1 (current-buffer) t)))
          (if next-point
              (progn
                (goto-char next-point)
                (contains-misbalanced-parentheses?))
            current-point))
      nil)))

(setq auto-mode-alist
      (cons '("\\.scm$" . scheme-mode)  auto-mode-alist))
(setq auto-mode-alist 
      (cons '("\\.ss$" . scheme-mode) auto-mode-alist))

(paren-set-mode 'paren)

;; Cycle Buffer rocks
;; ##################

(autoload 'cyclebuffer-forward "cyclebuffer" "cycle forward" t)
(autoload 'cyclebuffer-backward "cyclebuffer" "cycle backward" t)
(global-set-key "\M-N" 'cyclebuffer-forward)
(global-set-key "\M-P" 'cyclebuffer-backward)


;; various key bindings
;; ####################

(global-set-key [(control c) + c c] 'comment-region)
(global-set-key [(control c) + c u] 'uncomment-region)
(global-set-key [(control c) + r] 'revert-buffer)


;; PCL-CVS
;; #######
(when (run-on-insecure-client)
  (require 'pcl-cvs)  
  (setq cvs-program "cvs"))

;; diff-mode
;; #########
(add-hook 'diff-mode-hook 'turn-on-font-lock)

;; patcher
;; #######
(setq patcher-default-mail-method 'gnus
      patcher-mail-run-gnus t
      patcher-default-change-logs-appearance 'verbatim
      patcher-default-change-logs-prologue nil
      patcher-default-change-logs-updating 'manual)

(setq patcher-projects
      '(("XEmacs Xft branch" "/afs/wsi/pu/src/knauel/xe-xft/cvs-branch/xft-branch"
         :to-address "xemacs-patches@xemacs.org"
         :gnus-group "nnml:mail.soft.xemacs.patches"
         :subject-prefix "[AC sjt-xft]"
         :mail-prologue "APPROVE COMMIT sjt-xft")))

;; Haskell mode
;; ############
(defun my-haskell-constants ()
  (let ((systype (getenv "SYSTYPE"))
        (std-switches '("+." "-h4096k"))
        (fp2003-lib-path "/afs/wsi/pu/fp-2003/lib/hugs"))
    (if (not (and systype 
                  (member systype 
                          '("i386_fbsd46" "sun4x_58" "ppc_macx66"))))
        (progn
          (setq haskell-prog-switches std-switches)
          (message 
           (concat "Could not determine SYSTYPE / unsupported SYSTYPE. "
                   "Will not load Hugs Graphics library")))
      (setq haskell-prog-switches 
            (cons (concat "-P" fp2003-lib-path "/" systype "/x11:") std-switches))))
   (setq haskell-prog-name (executable-find "hugs")
         haskell-use-left-delim ""
         haskell-use-right-delim ""
         comint-prompt-pattern "^[A-Za-z0-9\-_]+> ")
   (set-face-background haskell-indentation-face
                        (make-color-specifier "yellow"))
   (set-face-background haskell-indentation-face-2
                        (make-color-specifier "yellow"))
   (define-key haskell-mode-map [delete] 'delete-char))

(add-hook 'haskell-mode-hook 'my-haskell-constants)

(setq auto-mode-alist 
      (cons '("\\.hs$" . haskell-mode)
            (cons '("\\.lhs$" . haskell-mode)
                  auto-mode-alist)))
(autoload 'haskell-mode "haskell-mode" "Major mode for editing Haskell." t)

;; Caml mode
;; #########
(add-hook 'caml-mode-hook
          '(lambda ()
             (define-key caml-mode-map "\M-\C-h" 'backward-kill-word)))


;; Apache mode
;; ###########
(autoload 'apache-mode "apache-mode" "autoloaded" t)
(add-to-list 'auto-mode-alist '("\\.htaccess$"   . apache-mode))
(add-to-list 'auto-mode-alist '("httpd\\.conf$"  . apache-mode))
(add-to-list 'auto-mode-alist '("srm\\.conf$"    . apache-mode))
(add-to-list 'auto-mode-alist '("access\\.conf$" . apache-mode))

(set-face-foreground 'font-lock-comment-face "darkgrey")
(set-face-foreground 'font-lock-keyword-face "limegreen")
(set-face-foreground 'font-lock-variable-name-face "khaki")
(set-face-foreground 'font-lock-function-name-face "khaki")
(set-face-foreground 'font-lock-string-face "peru")

;; tramp configuration
;; ###################
(let ((tramp-dir (expand-file-name "~/.xemacs/lisp/tramp")))
  (if (file-accessible-directory-p tramp-dir)
      (progn
        (setq load-path (cons tramp-dir load-path))
        (require 'tramp))))

(setq tramp-verbose 10
      tramp-debug-buffer t
      tramp-default-method "scp"
      tramp-shell-prompt-pattern  "\\(.*[]].*\\|# \\)")

;; Objective C
;; ###########
(defun my-objc-mode-hook ()
  (setq font-lock-keywords
        (append 
         '(("^@implementation" . font-lock-keyword-face)
           ("^@interface" . font-lock-keyword-face)
           ("@selector" . font-lock-keyword-face)
           ("^@end" . font-lock-keyword-face)
           ("\\<static\\>" . font-lock-keyword-face)
           
           ("\\<id\\>" . font-lock-type-face)
           ("\\<nil\\>" . font-lock-type-face)
           ("\\<self\\>" . font-lock-keyword-face)
           ("\\<super\\>" . font-lock-keyword-face)
           ("\\<BOOL\\>" . font-lock-type-face)

           ;; Class names
           ("\\<[A-Z][a-zA-Z]*\\>" . font-lock-reference-face)
           
           ;; Function names
           ("\\([_a-zA-Z0-9]+\\)(" 1 font-lock-function-name-face)
           
           ;; Macro's/constants
           ("\\<[_A-Z0-9]+\\>" 0 font-lock-preprocessor-face)
           
           ;; Imported files
           ("^#import <\\(.*\\)>" 1 blue t)
                
           ;; Method declarations and messages
           ("^[-|+][ ]*\\(([a-zA-Z *]*)\\)?[ ]*\\([_a-zA-Z0-9]*\\)[;]?" 2 default)
           ("[ ]+\\([_a-zA-Z0-9]+\\)[\]|:]" 1 default)
           ("[^:^[][ ]+\\([_a-zA-Z0-9]+\\)[\]|:]" 1 default))
         c-font-lock-keywords-2))
        (font-lock-mode))

(add-hook 'objc-mode-hook 'my-objc-mode-hook)
(setq auto-mode-alist 
      (cons '("\\.m$" . objc-mode) auto-mode-alist))

;; clock
;; #####
(require 'time)
(if (run-on-home-machinep)
    (setq display-time-mail-file (expand-file-name "~/mailsync/mailbox"))
  (setq display-time-mail-file (expand-file-name "~/mailspool/mailbox")))

(setq display-time-interval 5
      display-time-24hr-format t
      display-time-day-and-date t
      display-time-form-list '(date time-text mail load))
(display-time)

;; to be removed later. Stolen from Emacs, needed for paredit.el

(defun check-parens ()                  ; lame name?
  "Check for unbalanced parentheses in the current buffer.
More accurately, check the narrowed part of the buffer for unbalanced
expressions (\"sexps\") in general.  This is done according to the
current syntax table and will find unbalanced brackets or quotes as
appropriate.  (See Info node `(emacs)Parentheses'.)  If imbalance is
found, an error is signaled and point is left at the first unbalanced
character."
  (interactive)
  (condition-case data
      ;; Buffer can't have more than (point-max) sexps.
      (scan-sexps (point-min) (point-max))
    (scan-error (goto-char (nth 2 data))
                ;; Could print (nth 1 data), which is either
                ;; "Containing expression ends prematurely" or
                ;; "Unbalanced parentheses", but those may not be so
                ;; accurate/helpful, e.g. quotes may actually be
                ;; mismatched.
                (error "Unmatched bracket or quote"))
    (error (cond ((eq 'scan-error (car data))
                  (goto-char (nth 2 data))
                  (error "Unmatched bracket or quote"))
                 (t (signal (car data) (cdr data)))))))

(gnuserv-start)

;; Local Variables:
;; no-byte-compile: t
;; End: