;;; .emacs - an emacs initialization file created by Bill Clementson
(require 'cl)

;;__________________________________________________________________________
;;;;    Site-Specific Variables 

;; See if we're on MS Windows or Mac OS X
(defvar mswindows-p (string-match "windows" (symbol-name system-type)))
(defvar macosx-p (string-match "darwin" (symbol-name system-type)))

;; Some file locations are relative to the HOME or the BIN directory
(defvar home-dir)
(setq home-dir (expand-file-name "~"))
(if (not (equal (subseq home-dir -1) "/"))
    (setq home-dir (concat home-dir "/" )))
(defvar bin-dir
  (if (equal (subseq home-dir 2 -1) "/home")
      (concat home-dir "bin/" )
    (if mswindows-p
	"c:/bin/"
      (concat (expand-file-name "~") "/bin/"))))

(defvar common-lisp-hyperspec-root (concat home-dir "bin/docs/Hyperspec/"))

;; Setup for PLT Scheme
(when mswindows-p
  (defvar plt-dir (concat bin-dir "plt/"))
  (defvar mzscheme-program (concat plt-dir "mzscheme.exe"))
  (setenv "path" (concat plt-dir ";" (getenv "path")))
  (setenv "PLTHOME" plt-dir)
  (setenv "PLTCOLLECTS" (concat plt-dir "collects"))
  (setenv "HOMEDRIVE" (subseq home-dir 0 2))
  (setenv "HOMEPATH" (subseq home-dir 2))
  (setq quack-pltcollect-dirs (directory-files (concat plt-dir "collects") t)))

;; Set up load path 
(setq load-path (append (list (concat home-dir "")
			      (concat home-dir "site/ecb")
			      (concat home-dir "site/eieio")
			      (concat home-dir "site/elib")
			      (concat home-dir "site/emacs-cl")
			      (concat home-dir "site/erc-4.0")
			      (concat home-dir "site/jde/lisp")
			      (concat home-dir "site/nxml-mode")
			      (concat home-dir "site/semantic")
			      (concat home-dir "site/speedbar")
			      (concat home-dir "site/slime")
			      (concat home-dir "site/tiny-tools/lisp/tiny")
			      (concat home-dir "site"))
                        load-path))

;; Specify where backup files are stored
(setq backup-directory-alist (quote ((".*" . "~/.backups"))))

;; Location of Info documentation
(setenv "INFOPATH" nil t)
(setq-default Info-default-directory-list
	      (list (expand-file-name (concat home-dir "bin/info"))
		    (expand-file-name (concat (if mswindows-p
						  (getenv "EMACS_DIR")
						"/Applications/Emacs.app/Contents/Resources") "/info"))))

;;__________________________________________________________________________
;;;;    Initial Code Load

(require 'dired)
(require 'font-lock)
(require 'lazy-lock)
(require 'recentf)
(require 'mouse-sel)
(require 'hippie-exp)
(require 'browse-url)
(require 'comint)
(require 'slime)
(require 'blogmax)
(require 'color-theme)
(require 'ecb)
(require 'psvn)
(require 'xtla)
(require 'easymenu)
(easy-menu-add-item  nil '("tools")
		     ["IRC" erc-select t])
(autoload 'erc-select "erc" "IRC client." t)

;;__________________________________________________________________________
;;;;    System Customizations 

;; Set buffer behaviour
(setq next-line-add-newlines nil)
(setq scroll-step 1)
(setq scroll-conservatively 5)

;; Enable emacs functionality that is disabled by default
(put 'eval-expression 'disabled nil)
(put 'set-goal-column 'disabled nil)
(put 'narrow-to-page 'disabled nil)
(put 'narrow-to-region 'disabled nil)
(put 'eval-expression 'disabled nil)
(put 'downcase-region 'disabled nil)
(put 'upcase-region 'disabled nil)
(setq enable-recursive-minibuffers t)

;; Misc customizations
(fset 'yes-or-no-p 'y-or-n-p)           ;replace y-e-s by y
(setq inhibit-startup-message t)        ;no splash screen
(defconst use-backup-dir t)             ;use backup directory
(defconst query-replace-highlight t)    ;highlight during query
(defconst search-highlight t)           ;highlight incremental search
(setq ls-lisp-dirs-first t)             ;display dirs first in dired
(global-font-lock-mode t)               ;colorize all buffers
(setq ecb-tip-of-the-day nil)           ;turn off ECB tips
(recentf-mode 1)                        ;recently edited files in menu
(auto-compression-mode t)		;turn on auto file uncompression

;; Conventional mouse/arrow movement & selection
(pc-selection-mode)                 
(delete-selection-mode t)           

(defun maximize-frame (&optional frame)
"Maximize the selected FRAME."
(interactive)
(or frame
    (setq frame (selected-frame)))
(let ((pixels-per-col (/ (float (frame-pixel-width))
			 (frame-width)))
      (pixels-per-row (/ (float
			  (frame-pixel-height)) (frame-height))))
  (set-frame-size frame
		    (if (string= "w32" window-system)
			(+ (truncate (/ (x-display-pixel-width) pixels-per-col)) 2)
		      (truncate (/ (x-display-pixel-width) pixels-per-col)))
		    (if (string= "w32" window-system)
			(- (truncate (/ (x-display-pixel-height) pixels-per-row)) 2)
		      (- (truncate (/ (x-display-pixel-height) pixels-per-row)) 7)))
  (set-frame-position frame 0 0)))

(tool-bar-mode -1)
(if (string= "w32" window-system)
    (if (string-match "GNU Emacs 21.3.1" (emacs-version))
	(w32-send-sys-command 61488)
      (maximize-frame))
  (maximize-frame))

;; Custom size for my 17" PowerBook
(set-frame-position (selected-frame) 0 0)
(set-frame-size (selected-frame) 199 58)

;; Use ESC to exit popups
(defvar running-xemacs (if (string-match "XEmacs" emacs-version) t nil))
(defvar running-fsf    (and (not running-xemacs)
                            (string-match "^\\([0-9]+\\)\\." emacs-version)
                            (string-to-number (match-string 1 emacs-version))))
(defvar running-fsf21  (and running-fsf (>= running-fsf 21)))

(ignore-errors
  (load-library "electric-not.el"))

;; Always re-indent the top-level sexp
(defadvice indent-sexp (around indent-defun (&optional endpos))
  "Indent the enclosing defun (or top-level sexp)."
  (interactive)
  (save-excursion
    (beginning-of-defun)
    ad-do-it))

(ad-activate 'indent-sexp)

;; Ediff customizations
(defconst ediff-ignore-similar-regions t)
(defconst ediff-use-last-dir t)
(defconst ediff-diff-options " -b ")

;; Dired customizations
(setq dired-listing-switches "-l")

(defun dired-mouse-find-file (event)
  "In dired, visit the file or directory name you double-click on (EVENT)."
  (interactive "e")
  (let (file)
    (save-excursion
      (set-buffer (window-buffer (posn-window (event-end event))))
      (save-excursion
	(goto-char (posn-point (event-end event)))
	(setq file (dired-get-filename))))
    (select-window (posn-window (event-end event)))
    (find-file (file-name-sans-versions file t))))

(defun my-dired-find-file ()
  "In dired, visit the file or directory name you are on (in the same window)."
  (interactive)
  (let (file)
    (save-excursion
      (setq file (dired-get-filename))
      (find-file (file-name-sans-versions file t)))))

(add-hook 'dired-mode-hook
	  '(lambda()
	     (define-key dired-mode-map [delete] 'dired-do-delete)
	     (define-key dired-mode-map [(z)] 'svn-status)
	     (define-key dired-mode-map [C-return] 'dired-find-file-other-window)
	     (define-key dired-mode-map [C-down-mouse-1] 'mouse-buffer-menu)
	     (define-key dired-mode-map [double-down-mouse-1] 'dired-mouse-find-file)	     
	     (define-key dired-mode-map [return] 'my-dired-find-file)))

;; Word completion customizations
(defconst dabbrev-always-check-other-buffers t)
(defconst dabbrev-abbrev-char-regexp "\\sw\\|\\s_")

(setq hippie-expand-try-functions-list
      '(try-expand-dabbrev
	try-expand-dabbrev-all-buffers
	try-expand-dabbrev-from-kill
	try-complete-file-name-partially
	try-complete-file-name
	try-complete-lisp-symbol-partially
	try-complete-lisp-symbol
	try-expand-whole-kill))

;; Set the name of the host and current path/file in title bar:
(setq frame-title-format
      (list (format "%s %%S: %%j " (system-name))
	    '(buffer-file-name "%f" (dired-directory dired-directory "%b"))))

;; Column & line numbers in mode bar
(column-number-mode t)
(line-number-mode t)	

;; Code display options (highlight parens & colorize)
(show-paren-mode 1)
(setq font-lock-support-mode 'lazy-lock-mode)

;; Font lock colorization customizations
(defun color-theme-billc ()
  "Bill Clementson's custom color theme."
  (interactive)
  (color-theme-install
   '(color-theme-billc
     ((foreground-color . "black")
      (background-color . "white")
      (mouse-color . "sienna3")
      (cursor-color . "black")
      (border-color . "Blue")
      (background-mode . light))
     (default ((t (nil))))
     (modeline ((t (:background "dark gray" :foreground "black"))))
     (modeline-buffer-id ((t (:background "dark gray" :foreground "black"))))
     (modeline-mousable ((t (:background "dark gray" :foreground "black"))))
     (modeline-mousable-minor-mode ((t (:background "dark gray" :foreground "black"))))
     (highlight ((t (:foreground "black" :background "darkseagreen2"))))
     (bold ((t (:bold t))))
     (italic ((t (:italic t))))
     (bold-italic ((t (:bold t :italic t))))
     (region ((t (:foreground "black" :background "snow3"))))
     (secondary-selection ((t (:background "paleturquoise"))))
     (underline ((t (:underline t))))
     (lazy-highlight-face ((t (:foreground "dark blue" :bold t))))
     (font-lock-comment-face ((t (:foreground "dark green" :bold t :italic t))))
     (font-lock-string-face ((t (:foreground "SlateGray4" :bold t))))
     (font-lock-keyword-face ((t (:foreground "black" :bold t))))
     (font-lock-builtin-face ((t (:bold t :foreground "black"))))
     (font-lock-function-name-face ((t (:foreground "dark blue" :bold t))))
     (font-lock-variable-name-face ((t (:foreground "black"))))
     (font-lock-type-face ((t (:foreground "blue"))))
     (font-lock-constant-face ((t (:foreground "dark blue"))))
     (font-lock-warning-face ((t (:foreground "red" :bold t))))
     (widget-documentation-face ((t (:foreground "dark green"))))
     (widget-button-face ((t (:bold t))))
     (widget-field-face ((t (:background "gray85"))))
     (widget-single-line-field-face ((t (:background "gray85"))))
     (widget-inactive-face ((t (:foreground "dim gray"))))
     (widget-button-pressed-face ((t (:foreground "red"))))
     (custom-invalid-face ((t (:foreground "yellow" :background "red"))))
     (custom-rogue-face ((t (:foreground "pink" :background "black"))))
     (custom-modified-face ((t (:foreground "white" :background "blue"))))
     (custom-set-face ((t (:foreground "blue" :background "white"))))
     (custom-changed-face ((t (:foreground "white" :background "blue"))))
     (custom-saved-face ((t (:underline t))))
     (custom-button-face ((t (nil))))
     (custom-documentation-face ((t (nil))))
     (custom-state-face ((t (:foreground "dark green"))))
     (custom-variable-tag-face ((t (:foreground "blue" :underline t))))
     (custom-variable-button-face ((t (:bold t :underline t))))
     (custom-face-tag-face ((t (:underline t))))
     (custom-group-tag-face-1 ((t (:foreground "red" :underline t))))
     (custom-group-tag-face ((t (:foreground "blue" :underline t))))
     (speedbar-button-face ((t (:foreground "green4"))))
     (speedbar-file-face ((t (:foreground "cyan4"))))
     (speedbar-directory-face ((t (:foreground "blue4"))))
     (speedbar-tag-face ((t (:foreground "brown"))))
     (speedbar-selected-face ((t (:foreground "red"))))
     (speedbar-highlight-face ((t (:background "green"))))
     (ff-paths-non-existant-file-face ((t (:foreground "NavyBlue" :bold t))))
     (show-paren-match-face ((t (:background "light blue"))))
     (show-paren-mismatch-face ((t (:foreground "white" :background "purple")))))))

(ignore-errors
  (color-theme-billc))

;; Set fonts up on MS Windows
(if mswindows-p
    (progn
      ;; Show as much as we can using fonts bundled with IE5
      (setq w32-standard-fontset-spec
	    "-*-Courier New-normal-r-*-*-*-100-*-*-c-*-fontset-courier,
   ascii:-*-Courier New-normal-r-*-*-*-100-*-*-c-*-iso8859-1,
   latin-iso8859-1:-*-Courier New-normal-r-*-*-*-100-*-*-c-*-iso8859-1,
   latin-iso8859-2:-*-Courier New-normal-r-*-*-*-100-*-*-c-*-iso8859-2,
   latin-iso8859-3:-*-Courier New-normal-r-*-*-*-100-*-*-c-*-iso8859-3,
   latin-iso8859-4:-*-Courier New-normal-r-*-*-*-100-*-*-c-*-iso8859-4,
   latin-iso8859-7:-*-Courier New-normal-r-*-*-*-100-*-*-c-*-iso8859-7,
   latin-iso8859-9:-*-Courier New-normal-r-*-*-*-100-*-*-c-*-iso8859-9,
   cyrillic-iso8859-5:-*-Courier New-normal-r-*-*-*-100-*-*-c-*-iso8859-5,
   greek-iso8859-7:-*-Courier New-normal-r-*-*-*-100-*-*-c-*-iso8859-7,
   hebrew-iso8859-8:-*-Rod-normal-r-*-*-*-100-*-*-c-*-iso8859-8,
   ipa:-*-Lucida Sans Unicode-normal-r-*-*-*-100-*-*-c-*-muleipa*-*,
   thai-tis620:-*-Tahoma-normal-r-*-*-*-100-*-*-c-*-tis620-*,
   latin-jisx0201:-*-MS Gothic-normal-r-*-*-*-100-*-*-c-*-jisx0208-sjis,
   katakana-jisx0201:-*-MS Gothic-normal-r-*-*-*-100-*-*-c-*-jisx0208-sjis,
   japanese-jisx0208:-*-MS Gothic-normal-r-*-*-*-100-*-*-c-*-jisx0208-sjis,
   japanese-jisx0208-1978:-*-MS Gothic-normal-r-*-*-*-100-*-*-c-*-jisx0208-sjis,
   japanese-jisx0212:-*-MS Gothic-normal-r-*-*-*-100-*-*-c-*-jisx0212-sjis,
   korean-ksc5601:-*-Gulim-normal-r-*-*-*-100-*-*-c-*-ksc5601-*,
   chinese-gb2312:-*-MS Song-normal-r-*-*-*-100-*-*-c-*-gb2312-*,
   chinese-big5-1:-*-MingLiU-normal-r-*-*-*-100-*-*-c-*-big5-*,
   chinese-big5-2:-*-MingLiU-normal-r-*-*-*-100-*-*-c-*-big5-*")

      (setq w32-enable-italics t)
      (create-fontset-from-fontset-spec w32-standard-fontset-spec t)

      (setq default-frame-alist '((font . "fontset-courier")))

      (setq initial-frame-alist default-frame-alist)))

;;__________________________________________________________________________
;;;;    Programming - Common Lisp

;; Specify modes for Lisp file extensions
(setq auto-mode-alist
      (append '(
		("\\.lisp$" . lisp-mode)
		("\\.lsp$" . lisp-mode)
		("\\.cl$" . lisp-mode)
		("\\.asd$" . lisp-mode)
		("\\.system$" . lisp-mode)
		)auto-mode-alist))

(defun pretty-lambdas ()
  (font-lock-add-keywords
   nil `(("(\\(lambda\\>\\)"
	  (0 (progn (compose-region (match-beginning 1) (match-end 1)
				    ,(make-char 'greek-iso8859-7 107))
		    nil))))))

(defun clhs-info ()
  (interactive)
  (ignore-errors
    (info (concatenate 'string "(gcl) " (thing-at-point 'symbol)))))

(defun slime-send-dwim (arg)
  "Send the appropriate forms to CL to be evaluated."
  (interactive "P")
  (save-excursion
    (cond 
     ;;Region selected - evaluate region
     ((not (equal mark-active nil))
      (slime-eval-region (mark) (point)))
     ;; At/after sexp - evaluate last sexp
     ((or (looking-at "\\s\)")
	  (save-excursion
	    (backward-char 1)
	    (looking-at "\\s\)")))
      (if (looking-at "\\s\)")
	  (forward-char 1)) 
      (slime-eval-last-expression))
     ;; At/before sexp - evaluate next sexp
     ((or (looking-at "\\s\(")
	  (save-excursion
	    (forward-char 1)
	    (looking-at "\\s\(")))
      (forward-list 1)
      (slime-eval-last-expression))
     ;; Default - evaluate enclosing top-level sexp
     (t (progn
	  (while (ignore-errors (progn
				  (backward-up-list)
				  t)))
	  (forward-list 1)
	  (slime-eval-last-expression))))
    (if arg (progn
	      (set-buffer (slime-output-buffer))
	      (unless (eq (current-buffer) (window-buffer))
		(pop-to-buffer (current-buffer) t))
	      (goto-char (point-max))))))

(defvar *presentation-buffer* nil)

(defun slime-present ()
  (interactive)
  (setq *presentation-buffer* (current-buffer))
  (global-set-key [f9]
		  (lambda ()
		    (interactive)
		    (set-buffer *presentation-buffer*)
		    (forward-sexp)
		    (let ((end (point))
			  (beg (save-excursion
				 (backward-list 1)
				 (point))))
		      (copy-region-as-kill-nomark beg end)
		      (set-buffer (slime-output-buffer))
		      (unless (eq (current-buffer) (window-buffer))
			(pop-to-buffer (current-buffer) t))
		      (goto-char (point-max))
		      (yank)
		      (slime-reindent-defun)
		      (delete-other-windows)))))

(defun mwe:skeleton-pair-insert-maybe (&optional arg)
  (interactive "P")
  (save-excursion (skeleton-pair-insert-maybe arg))
  (forward-char))

(defun mwe:up-list-or-insert (&optional arg)
  "Skip over a closing parenthesis, unless no matching opening parenthesis is found.
   In this case insert one." 
  (interactive "p") (condition-case nil (up-list arg) (error
  (insert-char (logand last-command-char 255) 1))))

(global-set-key [f9] 'slime-send-dwim)
(global-set-key [(shift f9)] 'slime-present)
(global-set-key [(control c) (l)] 'slime-selector)

(add-hook 'lisp-mode-hook (lambda ()
			    (slime-mode t)
			    (define-key lisp-mode-map [(control j)] 'newline)
			    (define-key lisp-mode-map [(control m)] 'newline-and-indent)
			    (define-key lisp-mode-map [(control c) (\;)] 'insert-balanced-comments)
			    (define-key lisp-mode-map [(control c) (:)] 'remove-balanced-comments)
;; 			    (define-key lisp-mode-map [(\()] 'mwe:skeleton-pair-insert-maybe)
;; 			    (define-key lisp-mode-map [(\))] 'mwe:up-list-or-insert)
			    (define-key lisp-mode-map [f1] 'clhs-info)
			    (require 'hyperspe-addon)
			    (set (make-local-variable lisp-indent-function)
				 'common-lisp-indent-function)
			    (if mswindows-p (pretty-lambdas))))
(add-hook 'inferior-lisp-mode-hook (lambda ()
				     (inferior-slime-mode t)
				     (define-key inferior-lisp-mode-map [f1] 'clhs-info)
				     (if mswindows-p (pretty-lambdas))))
(slime-autodoc-mode)
(setq slime-edit-definition-fallback-function 'find-tag)

(require 'info-look)
(info-lookup-add-help
 :mode 'lisp-mode
 :regexp "[^][()'\" \t\n]+"
 :ignore-case t
 :doc-spec '(("(gcl)Symbol Index" nil nil nil)))

(defun replace-slime-cmd ()
  "Replaces regular Slime command."
  (interactive)
  (defun slime ()
    "Start Slime without an inferior lisp."
    (interactive)
    (while (not (ignore-errors (slime-connect "localhost" 4005) t))
      (sit-for 1))))

;; Armed Bear Common Lisp
(defun abcl ()
  (interactive)
  (shell-command (concat "java -Xss512K -cp "
			 home-dir "lisp/j/j.jar"
			 " org.armedbear.lisp.Main "
			 "--load " home-dir ".slime.lisp &"))
  (replace-slime-cmd))

;; Franz Allegro Common Lisp
(defun acl ()
  (interactive)
  (if mswindows-p
      (shell-command (concat bin-dir "acl-7.0/alisp.exe"
			     " +B +cm -L " home-dir ".slime.lisp&"))
    (shell-command (concat bin-dir "acl-7.0/alisp"
			   " -L " home-dir ".slime.lisp&"))
    (delete-other-windows))
  (replace-slime-cmd))

;; GNU CLISP
(defun clisp ()
  (interactive)
  (if mswindows-p
      (setq inferior-lisp-program (concat bin-dir "clisp-2.33/full/lisp.exe"
					  " -B " bin-dir "clisp-2.33/full/"
					  " -M " bin-dir "clisp-2.33/full/lispinit.mem"
					  " -i " home-dir ".slime.lisp"
					  " -ansi -q"))
  (setq inferior-lisp-program (concat "/Users/bc/bin/clisp-2.33/base/lisp.run"
				      " -M /Users/bc/bin/clisp-2.33/base/lispinit.mem"
				      " -i " home-dir ".slime.lisp"
				      " -ansi -q")))
  (load "slime"))

;; CMUCL
(defun cmucl ()
  (interactive)
  (setq cmucl-dir "/Users/bc/bin/cmucl/bin")
  (setenv "PATH" (concat cmucl-dir ":" (getenv "PATH")))
  (setq inferior-lisp-program "/Users/bc/bin/cmucl/bin/lisp")
  (load "slime"))

;; OpenMCL
(defun openmcl ()
  (interactive)
  (setq openmcl-dir "/Users/bc/bin/ccl")
  (setenv "PATH" (concat openmcl-dir ":" (getenv "PATH")))
  (setenv "CCL_DEFAULT_DIRECTORY" "/Users/bc/bin/ccl")
  (setq inferior-lisp-program "/Users/bc/bin/ccl/dppccl")
  (load "slime"))

;; SBCL
(defun sbcl ()
  (interactive)
  (setq sbcl-dir "/Users/bc/bin/sbcl/bin")
  (setenv "PATH" (concat sbcl-dir ":" (getenv "PATH")))
  (setenv "SBCL_HOME" "/Users/bc/bin/sbcl/lib/sbcl")
  (setq inferior-lisp-program "/Users/bc/bin/sbcl/bin/sbcl")
  (load "slime"))

;; Xanalys LispWorks 
(defun lw ()
  (interactive)
  (if mswindows-p
      (setq inferior-lisp-program (concat bin-dir "lispworks-4.4/lw-console.exe"
					  " -init " home-dir ".slime.lisp"))
    (setq inferior-lisp-program (concat "/Applications/LispWorks-4.4/LispWorks.app/Contents/MacOS/lw-console"
					" -init " home-dir ".slime.lisp")))
  (load "slime"))

;; Xanalys LispWorks Personal
(defun lwp ()
  (interactive)
  (if mswindows-p
      (shell-command (concat home-dir ".lw-slime.vbs&"))
    (shell-command "~/Library/Scripts/lw-start.app&"))
  (delete-other-windows)
  (replace-slime-cmd))

;; Specify the default CL implementation:
(if mswindows-p
    (lw)
  (openmcl))

;; Shortcut key for starting Slime
(global-set-key [f5] 'slime)

;;__________________________________________________________________________
;;;;    Programming - Scheme

;; Specify modes for Scheme file extensions
(setq auto-mode-alist
      (append '(
		("\\.emacs$" . emacs-lisp-mode)
		("\\.scm$" . scheme-mode)
		("\\.ss$" . scheme-mode)
		("\\.sch$" . scheme-mode)
		)auto-mode-alist))

;; Scheme & Info Mode Hooks
(add-hook 'scheme-mode-hook
	  (lambda ()
	    (define-key scheme-mode-map [f1]
	      '(lambda ()
		 (interactive)
		 (ignore-errors
		   (let ((symbol (thing-at-point 'symbol)))
		     (info "(r5rs)")
		     (Info-index symbol)))))
	    (mapc (lambda (key-arg)
                    (define-key scheme-mode-map (car key-arg)
                      (eval `(lambda ()
                               (interactive)
                               (-test ,(cadr key-arg))))))
                  '(([(control c) (control m)] nil)
                    ([(control c) (h)]         :this)
                    ([(control c) (e)]         :expand)
                    ([(control c) (o)]         :expand-once)
                    ([(control c) (*)]         :expand*)
                    ([(control c) (p)]         :pp)))
	    (define-key scheme-mode-map [(control c) (x)] 'scheme-send-dwim)
	    (define-key scheme-mode-map [(control c) (\;)] 'insert-balanced-comments)
	    (define-key scheme-mode-map [(control c) (:)] 'remove-balanced-comments)
	    (define-key scheme-mode-map [(control c) (t)]
	      (lambda (prefix)
		(interactive "P")
		(-trace "trace" prefix)))
	    (define-key scheme-mode-map [(control c) (T)]
	      (lambda (prefix)
		(interactive "P")
		(-trace "trace-all" prefix)))
	    (imenu-add-to-menubar "Symbols")
	    (outline-minor-mode)
	    (if mswindows-p (pretty-lambdas))
	    (make-local-variable 'outline-regexp)
	    (setq outline-regexp "^(.*")))

(add-hook 'Info-mode-hook
	  (lambda ()
	    (interactive)
	    (define-key Info-mode-map [(control c) (x)] 'scheme-send-dwim)))

;; Start up Scheme
(global-set-key [(shift f5)]
		'(lambda ()
		   (interactive)
		   (require 'quack)
		   (run-scheme mzscheme-program)))

;; Scheme-specific Functions
(defun insert-balanced-comments (arg)
  "Insert a set of balanced comments around the s-expression 
containing the point.  If this command is invoked repeatedly
(without any other command occurring between invocations), the 
comment progressively moves outward over enclosing expressions."
  (interactive "*p")
  (save-excursion
    (when (eq last-command this-command)
      (when (search-backward "#|" nil t)
        (save-excursion
          (delete-char 2)
          (while (and (< (point) (point-max)) (not (looking-at " *|#")))
            (forward-sexp))
          (replace-match ""))))
    (while (> arg 0)
      (backward-char 1)
      (cond ((looking-at ")") (incf arg))
            ((looking-at "(") (decf arg))))
    (insert "#|")
    (forward-sexp)
    (insert "|#")))

(defun remove-balanced-comments ()
  "Remove a set of balanced comments enclosing point."
  (interactive "*")
  (save-excursion
    (when (search-backward "#|" nil t)
      (delete-char 2)
      (while (and (< (point) (point-max)) (not (looking-at " *|#")))
	(forward-sexp))
      (replace-match ""))))

(defun kill-this-buffer-lisp ()
  (interactive)
  (cond
   ((eq (current-buffer) (get-buffer "*scheme*"))
    (let ((process (get-buffer "*scheme*")))
      (comint-snapshot-last-prompt)
      (process-send-string process "(exit)"))
    (sleep-for .1)
    (kill-this-buffer))
   (t (kill-this-buffer))))

(defun kill-all-process-buffers ()
  (mapc (lambda (buffer)
	  (if (get-buffer buffer)
	      (progn
		(pop-to-buffer buffer)
		(kill-this-buffer-lisp))))
	'("*scheme*"))
  (if mswindows-p
      (ignore-errors
	(progn 
	  (require 'gnuserv) 
	  (gnuserv-start t))))) 

(defun scheme-send-dwim (arg)
  "Send the appropriate forms to Scheme to be evaluated."
  (interactive "P")
  (save-excursion
    (cond 
     ;;Region selected - evaluate region
     ((not (equal mark-active nil))
      (scheme-send-region (mark) (point)))
     ;; At/after sexp - evaluate last sexp
     ((or (looking-at "\\s\)")
	  (save-excursion
	    (backward-char 1)
	    (looking-at "\\s\)")))
      (if (looking-at "\\s\)")
	  (forward-char 1)) 
      (scheme-send-last-sexp))
     ;; At/before sexp - evaluate next sexp
     ((or (looking-at "\\s\(")
	  (save-excursion
	    (forward-char 1)
	    (looking-at "\\s\(")))
      (if (looking-at "\\s\(")
	  (forward-list 1)) 
      (scheme-send-last-sexp))
     ;; Default - evaluate enclosing top-level sexp
     (t (scheme-send-definition)))
    (if arg (switch-to-scheme t))))

;; MzScheme Macro expansion
(defvar mzexpand-actions
  '(nil :this :expand :expand-once :expand* :pp))

(defvar mzexpand-cache nil)

(defun mzexpand-get-action ()
  (unless (eq (car mzexpand-cache) mzexpand-actions)
    (setq mzexpand-cache
          (cons mzexpand-actions
                (mapcar (lambda (a)
                          (list (replace-regexp-in-string
                                 "^:" "" (format "%s" a))
                                a))
                        mzexpand-actions))))
  (cdr (assoc (completing-read "Action? " mzexpand-cache nil t)
              (cdr mzexpand-cache))))

(defun -test (action)
  "Scheme syntax debugging. Uses Scheme code originally developed by
Eli Barzilay.  Actions: nil set current using sexp at point
 :this        show current
 :expand      expand current (possibly in a context)
 :expand-once expand one step
 :expand*     expand one step repeatedly
 :pp          pprint current"
  (interactive (mzexpand-get-action))
  (comint-send-string (get-buffer-process "*scheme*")
                      (format "(-test %S)" (or action 
					       (sexp-at-point))))
  (pop-to-buffer "*scheme*" t)
  (other-window 1))

;; MzScheme Trace
(defun -trace (action &optional prefix)
  (interactive)
  (let ((symb nil))
    (if (or (equal action "trace")
	    (equal action "untrace"))
	(setq symb (symbol-at-point)))
    (if prefix
	(setq action (concat "un" action)))
    (comint-send-string (get-buffer-process "*scheme*")
			(if symb
			    (format "(%s %S)" action symb)
			  (format "(%s)" action))))
  (pop-to-buffer "*scheme*" t)
  (other-window 1))

;;__________________________________________________________________________
;;;;    Programming - Elisp

(add-hook 'emacs-lisp-mode-hook
	  '(lambda ()
	     (interactive)
	     (require 'eldoc)
	     (turn-on-eldoc-mode)
	     (if mswindows-p (pretty-lambdas))
	     (setq tinylisp-:mode-prefix-key  "$")
	     (require 'tinylisp)
	     ;; Default to auto-indent on Enter
	     (define-key emacs-lisp-mode-map [(control j)] 'newline)
	     (define-key emacs-lisp-mode-map [(control m)] 'newline-and-indent)))

;;__________________________________________________________________________
;;;; Weblog

;; {dailyLink-full} macro - use full URL so that RSS feed has the
;; correct link (if the RSS is being provided from a different
;; directory or server)
(defun weblog-macro-dailyLink-full ()
  (if (null *weblog-index-files*)
      "" ;; Regular day page. Don't include link.
    ;; Creating index page. Include link.
    (let* ((file (concat
                  (file-name-sans-extension
                   (file-name-nondirectory *weblog-story-file*))
                  ".html")))
      (concat "<a href=\"{url}" file
              "\" title=\"Permanent link to this day: "
              file "\">"
              "<img src=\"{url}dailyLinkIcon.png\" alt=\"Daily\"></a>"))))

;; Enhanced to generate RSS for multiple postings
(defun weblog-make-rss (&optional text-file)
  "Create rss.xml from rss-template.xml and the newest html files.
Upload it to the FTP server."
  (interactive)
  (weblog-with-init-params
   (buffer-file-name)
   (weblog-while-visiting-weblog-file
    rss-buf "rss.xml"
    (let* ((*weblog-index-files*
	    (delete-if
	     '(lambda (file)
		(apply 'weblog-mdy-in-future-p (weblog-file-mdy file)))
	     (nreverse (last (directory-files
			      *weblog-directory* nil
			      *weblog-file-regexp*)
			     *weblog-index-days*))))
	   (template (weblog-file-contents "rss-template.xml"))
	   (time (decode-time (current-time)))
	   (time-string (concat (weblog-rss-format-time time t)
				" GMT")))
      (set-buffer rss-buf)
      (erase-buffer)
      (insert template)
      (weblog-replace-xml-tag-text "<item>" "</item>" nil)
      (dolist (text-file *weblog-index-files*)
	(let ((text (weblog-file-contents text-file))
	      (html-buf (create-file-buffer text-file)))
	  (backward-delete-char 1)
	  (set-buffer html-buf)
	  (insert text)
	  (let ((*weblog-story-file* text-file)
		(*weblog-story-modtime* (nth 5 (file-attributes text-file))))
	    (weblog-expand-buffer nil (weblog-file text-file)))
	  (set-buffer html-buf)
	  (weblog-make-urls-absolute)
	  (goto-char (point-min))
	  (loop
	   (let* ((start (point))
		  (end (search-forward "<h3>" nil t))
		  (real-end (if end (- end 4) (point-max)))
		  (text (buffer-substring start real-end))
		  (link (cadr (weblog-parse-out-links start real-end))))
	     (setq text (weblog-neuter-tags text))
	     ;; This is for the Feedreader browser
	     (setq text (weblog-replace-strings text "\n" " \n"))
	     (set-buffer rss-buf)
	     (insert "\n<item>\n")
	     (insert "<title>")
	     (let ((*weblog-story-content* (weblog-absolute-file-contents text-file)))
	       (insert (weblog-macro-title)))
	     (insert "</title>\n")
	     (insert "<link>")
	     (insert (concat
		      *weblog-url*
		      (file-name-sans-extension
		       (file-name-nondirectory text-file))
		      ".html"))
	     (insert "</link>\n")
	     (insert "<description>")
	     (insert text)
	     (insert "</description>\n")
	     (insert "</item>\n")
	     (set-buffer html-buf)
	     (unless end (return))
	     (if (eql (point) (point-max)) (return))
	     (goto-char end)))
	  (kill-buffer html-buf)
	  (set-buffer rss-buf)
	  (save-buffer)))
      (weblog-upload)))))
  
;; Added following variable and modified weblog-upload to provide for
;; never uploading the .txt source files
(defvar *weblog-never-upload-source* t)

(defun weblog-upload (&optional dont-upload-source file-name)
  "Upload the current buffer to the FTP directory.
Upload only the HTML file for a text file if dont-upload-source is true.
If FILE-NAME is non-nil, upload that file and don't generate html."
  (interactive)
  (let ((file (or file-name (buffer-file-name))))
    (weblog-with-init-params file
      (let* ((buf (current-buffer))
             (textp (equalp (file-name-extension file) "txt"))
             (html-name (if textp
                            (concat (file-name-sans-extension file) ".html")
                          file))
             (name (weblog-file-relative-name html-name *weblog-directory*)))
        (unless file-name
          (if textp
              (weblog-save-both)
            (when (buffer-modified-p) (save-buffer))))
        (if (eq name file)
            (message "Buffer not in *weblog-directory*")
          (let ((ftp-name (concat *weblog-ftp-directory* name))
                (source (if textp html-name file)))
            ;; Don't use copy-file here. It doesn't work on my FTP server.
            (weblog-write-text-to-file (weblog-absolute-file-contents source)
                                       ftp-name)
            (when (and textp
		       (not dont-upload-source)
		       (not *weblog-never-upload-source*))
              (setq ftp-name (concat (file-name-sans-extension ftp-name) ".txt"))
              (weblog-write-text-to-file (weblog-absolute-file-contents file)
                                         ftp-name))))
        (when textp
          (set-buffer buf)
          (let ((latest-text-file (weblog-latest-text-file)))
            (when (and latest-text-file
		       (weblog-file-in-base-dir file)
                       (equal (weblog-file-mdy file)
                              (weblog-file-mdy (weblog-file latest-text-file))))
              (weblog-make-rss latest-text-file))))))))

;;__________________________________________________________________________
;;;; JDEE

(setq defer-loading-jde t)

(if defer-loading-jde
    (progn
      (autoload 'jde-mode "jde" "JDE mode." t)
      (setq auto-mode-alist
	    (append
	     '(("\\.java\\'" . jde-mode))
	     auto-mode-alist)))
  (require 'jde))

;; Sets the basic indentation for Java source files
;; to three spaces.
(defun my-jde-mode-hook ()
  (setq c-basic-offset 3))

(add-hook 'jde-mode-hook 'my-jde-mode-hook)

;;__________________________________________________________________________
;;;; Python

(autoload 'python-mode "python-mode" "Python mode." t)
(setq auto-mode-alist
      (append
       '(("\\.py\\'" . python-mode))
       auto-mode-alist))

;;__________________________________________________________________________
;;;;    Standard Key Overrides

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

;; Mouse 
(global-set-key [down-mouse-2] 'imenu)
(global-set-key [C-M-down-mouse-1] 'widget-button-click)

;; Disable mouse-2 event that was appending text into documents
(global-set-key [mouse-2] nil)

;; Prevent accidentally killing emacs.
(global-set-key [(control x) (control c)]
		'(lambda ()
		   (interactive)
		   (if (y-or-n-p-with-timeout "Do you really want to exit Emacs ? " 4 nil)
		       (save-buffers-kill-emacs))))

;; Close down Lisp before killing buffer
(global-set-key [f4] 'kill-this-buffer-lisp)

;; Better buffer list.
(global-set-key [(control x) (control b)] 'electric-buffer-list)

;; Common buffer/window control shortcuts
(global-set-key [f6] 'other-window)
(global-set-key [f7] 'delete-other-windows)
(global-set-key [(control f7)] 'ecb-toggle-ecb-windows)
(global-set-key [(meta f7)] 'ecb-toggle-layout)
(global-set-key [f8] 'delete-window)

;; Shells:
;; eshell

(setq eshell-cp-interactive-query t
      eshell-ln-interactive-query t
      eshell-mv-interactive-query t
      eshell-rm-interactive-query t
      eshell-mv-overwrite-files nil)

(add-hook 'eshell-mode-hook
          '(lambda ()
	     (define-key eshell-mode-map [up] 'previous-line)
	     (define-key eshell-mode-map [down] 'next-line)
	     (eldoc-mode)
	     (defadvice eldoc-fnsym-in-current-sexp (around eldoc-fnsym-in-current-sexp-or-command activate)
	       ad-do-it
	       (if (and (not ad-return-value)
			(eq major-mode 'eshell-mode))
		   (save-excursion
		     (goto-char eshell-last-output-end)
		     (setq ad-return-value (eldoc-current-symbol)))))))

(defun eshell/op (FILE)
  "Invoke (w32-shell-execute \"Open\" FILE) and substitute slashes for backslashes"
  (w32-shell-execute "Open" (substitute ?\\ ?/ (expand-file-name FILE))))

(defun eshell/ff (&rest files)
  "Invoke `find-file' on all files."
  (if (listp (car files))
      (progn
     	(let ((files2 (car files)))
     	  (while files2
     	    (find-file (pop files2)))))
    (while files
      (find-file (pop files)))))

(eval-after-load "em-ls"
  '(progn
     (defun ted-eshell-ls-find-file-at-point (point)
       "RET on Eshell's `ls' output to open files."
       (interactive "d")
       (find-file (buffer-substring-no-properties
		   (previous-single-property-change point 'help-echo)
		   (next-single-property-change point 'help-echo))))

     (defun pat-eshell-ls-find-file-at-mouse-click (event)
       "Middle click on Eshell's `ls' output to open files."
       (interactive "e")
       (ted-eshell-ls-find-file-at-point (posn-point (event-end event))))

     (let ((map (make-sparse-keymap)))
       (define-key map (kbd "RET")      'ted-eshell-ls-find-file-at-point)
       (define-key map (kbd "<return>") 'ted-eshell-ls-find-file-at-point)
       (define-key map (kbd "<mouse-2>") 'pat-eshell-ls-find-file-at-mouse-click)
       (defvar ted-eshell-ls-keymap map))

     (defadvice eshell-ls-decorated-name (after ted-electrify-ls activate)
       "Eshell's `ls' now lets you click or RET on file names to open them."
       (add-text-properties 0 (length ad-return-value)
			    (list 'help-echo "RET, mouse-2: visit this file"
				  'mouse-face 'highlight
				  'keymap ted-eshell-ls-keymap)
			    ad-return-value)
       ad-return-value)))

(defun eshell/ec (&rest args)
  "Use `compile' to do background makes."
  (if (eshell-interactive-output-p)
      (let ((compilation-process-setup-function
	     (list 'lambda nil
		   (list 'setq 'process-environment
			 (list 'quote (eshell-copy-environment))))))
	(compile (eshell-flatten-and-stringify args))
        (pop-to-buffer compilation-last-buffer))
    (throw 'eshell-replace-command
           (let ((l (eshell-stringify-list (eshell-flatten-list args))))
             (eshell-parse-command (car l) (cdr l))))))

(put 'eshell/ec 'eshell-no-numeric-conversions t)

(global-set-key [f12]
		'(lambda ()
		   (interactive)
		   (eshell)))

;; Win32 shell
(global-set-key [(control f12)]
		'(lambda ()
		   (interactive)
		   (cond
		    (mswindows-p
		     (let ((explicit-shell-file-name
			    (expand-file-name (concat (getenv "EMACS_DIR") "/bin/cmdproxy.exe")))
			   (shell-file-name "cmdproxy.exe"))
		       (shell)))
		    (t (shell)))))

;; bash
(global-set-key [(meta f12)]
		'(lambda ()
		   (interactive)
		   (let ((explicit-shell-file-name
			  (if mswindows-p
			      "bash.exe"
			    "bash"))
			 (shell-file-name
			  (if mswindows-p
			      "bash.exe"
			    "bash")))
		     (shell))))

;; Shortcuts to common functions
(global-set-key [(control c) (a)] 'mark-whole-buffer)
(global-set-key [(control c) (f)] 'find-function-at-point)
(global-set-key [(control c) (F)] 'ffap)
(global-set-key [(control c) (g)] 'goto-line)	
(global-set-key [(control c) (j)] 'join-line)
(global-set-key [(control c) (/)] 'hippie-expand)
  
(global-set-key [(control c) (r)]
		(function
		 (lambda ()
		  (interactive)
		  (let ((arg (thing-at-point 'symbol)))
		    (search-backward arg)))))

(global-set-key [(control c) (s)]
		(function
		 (lambda ()
		   (interactive)
		   (let ((arg (thing-at-point 'symbol)))
		     (search-forward arg)))))

;; Ctrl-tab, Ctrl-F4, etc like MS Windows
(ignore-errors
  (progn
    (require 'cua-emul)
    (setq cua-emul-force t)
    (turn-on-cua-emul-mode)))

;; C-z=Undo, C-c=Copy, C-x=Cut, C-v=Paste
(ignore-errors
  (progn
    (if (string-match "GNU Emacs 21.3.1" (emacs-version))
	(progn
	  (ignore-errors (require 'cua))
	  (CUA-mode t))
      (ignore-errors (require 'cua-base))
      (cua-mode t))))

;; Kill any active lisp before killing frame
(global-set-key [(meta f4)]
		'(lambda ()
		   (interactive)
		   (kill-all-process-buffers)
		   (cua-emul-kill-frame)))

;;__________________________________________________________________________
;;;;    MS Windows Customizations

(if mswindows-p
    (progn
      ;; Grep equivalents on Windows
      ;;(setq grep-command "c:/cygwin/bin/grep.exe -n -a -e ")
      ;;(setq grep-command "findstr /n /s ")

      ;; Windows Execute from dired
      (define-key dired-mode-map "w"
	(function
	 (lambda ()
	   (interactive)
	   (setq w32-shellex-no-dired-hook t)
	   (require 'w32-shellex)
	   (w32-shellex-dired-on-objects))))

      ;; Start gnuserv on Windows 
      (ignore-errors
	(progn 
	  (require 'gnuserv) 
	  (setq server-done-function 'bury-buffer 
		gnuserv-frame (car (frame-list))) 
	  (gnuserv-start) 
	  ;; Open buffer in existing frame instead of creating new one... 
	  (setq gnuserv-frame (selected-frame)) 
	  (message "gnuserv started.")))))

;;__________________________________________________________________________
;;;;    Mac OS X Customizations

(if macosx-p
    (progn
      ;; fix a mac-specific problem with ptys
      (setq process-connection-type nil)
       ;; repair bogus default directory
      (if (equal default-directory "/") (setq default-directory "~/"))
               
      ;; Mac-style cut/copy/paste
      (setq mac-command-key-is-meta nil)
      (setq cua-enable-cua-keys nil)
      
      (global-set-key [(alt x)] 'cua-cut-region)
      (global-set-key [(alt c)] 'cua-copy)
      (global-set-key [(alt v)] 'cua-paste)
      (global-set-key [(alt a)] 'mark-whole-buffer)
      (global-set-key [(alt s)] 'save-buffer)
      (global-set-key [(alt S)] 'write-file)
      (global-set-key [(alt p)] 'ps-print-buffer)
      (global-set-key [(alt o)] 'find-file)
      (global-set-key [(alt q)] 'save-buffers-kill-emacs)
      (global-set-key [(alt w)] 'kill-buffer-and-window)
      (global-set-key [(alt z)] 'undo)
      (global-set-key [(alt f)] 'isearch-forward)
      (global-set-key [(alt g)] 'query-replace)
      (global-set-key [(alt l)] 'goto-line)
      (global-set-key [(alt m)] 'iconify-frame)
      (global-set-key [(alt n)] 'new-frame)
      (global-set-key [kp-delete] 'delete-char)
      (global-set-key [(control kp-home)] 'beginning-of-buffer)
      (global-set-key [(control kp-end)] 'end-of-buffer)
      
      ;; Mac Open/Execute from dired
      (define-key dired-mode-map "w"
	(function
	 (lambda ()
	   (interactive)
	   (shell-command (concat "/usr/bin/open " (dired-get-filename))))))))

;;__________________________________________________________________________
;;;;    IRC Customizations

(defun irc ()
  "Start IRC with ERC."
  (interactive)
  (select-frame (make-frame '((name . "Emacs IRC")
 			      (minibuffer . t))))
  (call-interactively 'erc-ifs))

(add-hook 'erc-mode-hook
          '(lambda ()
	     (erc-add-scroll-to-bottom)
	     (require 'erc-show)
	     (require 'erc-imenu)
	     (require 'erc-menu)))

;;__________________________________________________________________________
;;;;    Start Directory

(find-file "~/")

;;__________________________________________________________________________
;;;;    Customizations

(custom-set-variables
  ;; custom-set-variables was added by Custom.
  ;; If you edit it by hand, you could mess it up, so be careful.
  ;; Your init file should contain only one such instance.
  ;; If there is more than one, they won't work right.
 '(erc-autojoin-channels-alist (quote ((".*freenode.net" "#lisp"))))
 '(erc-autojoin-domain-only nil)
 '(erc-autojoin-mode t nil (erc-autojoin))
 '(erc-echo-notices-in-current-buffer t)
 '(erc-fill-column 115)
 '(erc-hide-list (quote ("JOIN" "KICK" "NICK" "PART" "QUIT")))
 '(erc-insert-timestamp-function (quote erc-insert-timestamp-left))
 '(erc-keywords (quote ("bill-c" "slime" "Bill")))
 '(erc-modules (quote (autoaway autojoin button completion fill netsplit notify pcomplete replace ring services smiley track truncate)))
 '(erc-nick "bill-c")
 '(erc-port "6667")
 '(erc-stamp-mode t nil (erc-stamp))
 '(erc-user-full-name "Bill Clementson")
 '(eshell-modules-list (quote (eshell-alias eshell-banner eshell-basic eshell-cmpl eshell-dirs eshell-glob eshell-hist eshell-ls eshell-pred eshell-prompt eshell-script eshell-smart eshell-term eshell-unix)))
 '(eshell-save-history-on-exit t)
 '(jde-built-class-path (quote (".")))
 '(jde-debugger (quote ("JDEbug")))
 '(jde-enable-abbrev-mode t)
 '(jde-global-classpath (quote (".")))
 '(jde-jdk-registry (quote (("1.4.2" . "C:/bin/j2sdk1.4.2_03"))))
 '(jde-sourcepath (quote (".")))
 '(max-lisp-eval-depth 10000)
 '(max-specpdl-size 2000)
 '(recentf-exclude (quote (".ftp:.*")))
 '(tool-bar-mode nil nil (tool-bar)))
(custom-set-faces
  ;; custom-set-faces was added by Custom.
  ;; If you edit it by hand, you could mess it up, so be careful.
  ;; Your init file should contain only one such instance.
  ;; If there is more than one, they won't work right.
 '(quack-pltish-comment-face ((((class color) (background light)) (:foreground "green4" :slant italic :weight bold))))
 '(quack-pltish-selfeval-face ((((class color) (background light)) (:foreground "SlateGray4" :weight bold))))
 '(quack-threesemi-semi-face ((((class color) (background light)) (:background "gray88" :foreground "green4" :weight bold))))
 '(quack-threesemi-text-face ((((class color) (background light)) (:background "gray88" :foreground "green4" :weight bold)))))

;; Overrides
(global-set-key [f6] 'other-window)

;; end of emacs.el