;;; checker's .emacs file 

;; .emacs todos (otherwise known as emacssucks.txt):
;; - perl-mode
;;   - understand here documents
;;   - understand qw and other variable brackets
;;   - push @l,<return> tab messed up
;; - smtpmail - try muliple smtp servers...
;; - horizontal split glyph should match modeline inverse video!
;; - make truncate-lines not suck and actually word-wrap if told to
;; - cc-mode - line up ternary operator parms on separate lines:
;;      a ? b :
;;          c;
;;   even in arglists
;; - cc-mode - in arglist-conts make math override arglist indent
;; - dictionary, thesaurus, deja, altavista lookups (/tmp/test.el)
;; - _ not a \w constituent in c++ mode?
;; - hex/octal/binary calculator
;; - start using personal lisp folder and mirroring to website
;; - rectangle insertion command that inserts blank lines first
;; - copy-rectangle in addition to yank
;; - figure out why indent-region is so slow!!!
;; - distance between point and mark in mode line (/tmp/test.el)
;; - partial completion when already inside a word
;; - make cc-mode paragraph regex's appropriate, { } if, else, etc.
;; - font-lock on gl.h is really slow, and killing it part way through
;;   makes the buffer modified...
;; - my way of setting the newly read file to readonly breaks libraries
;; - make dabbrev-expand check for completions that match around
;;   cursor, so you can be in front of _foobar and it'll expand to
;;   blah_foobar, not blah_foobar_foobar if blah_foobar is a symbol
;; - pass -z9 to cvs in vc package
;; - make checker-ediff-revision not prompt for revision without arg
;; - add cvs-status command
;; - make c-mode indents relative to c-basic-offset

;(setq debug-on-error t)
(setq kill-emacs-query-functions
      (cons (lambda () (yes-or-no-p "Really kill Emacs? "))
            kill-emacs-query-functions))
(auto-compression-mode t)
(setq load-path 
      (append '( "~/lisp"
		 "~/lisp/caml"
                 "~/lisp/icicles"
		 ;; add new paths here
		 ) 
	      (if (string-match "21.3" (emacs-version))
		  '("~/lisp/21.3"
                    "~/lisp/21.3/calc/calc-2.02f"
		    "~/lisp/21.3/psgml-1.2.1"
		    "~/lisp/21.3/pcl-cvs"
		    "~/lisp/21.3/elib-1.0"))
	      load-path))
(load-library "Info")
(setq Info-additional-directory-list
      (append '(
                "~/info"
		"~/../apps/ocaml/src/3.06/infoman"
		)
	      (if (string-match "21.3" (emacs-version))
		  '("~/lisp/calc/calc-2.02f"))
		) Info-additional-directory-list)


(cond
 ((string-match "21.3" (emacs-version))
  )
 ((string-match "22" (emacs-version))
  (server-start)
  (add-hook 'server-switch-hook
            (lambda nil
              (let ((server-buf (current-buffer)))
                (bury-buffer)
                (switch-to-buffer-other-frame server-buf))))
  )) 


(load "auctex.el" nil t t)
(load "preview-latex.el" nil t t)

(autoload 'css-mode "css-mode")
(setq auto-mode-alist (cons '("\\.css\\'" . css-mode) auto-mode-alist))
(setq cssm-indent-function #'cssm-c-style-indenter)

;;; Commands added by calc-private-autoloads on Sat Sep 09 02:08:17 2006.
(autoload 'calc-dispatch	   "calc" "Calculator Options" t)
(autoload 'full-calc		   "calc" "Full-screen Calculator" t)
(autoload 'full-calc-keypad	   "calc" "Full-screen X Calculator" t)
(autoload 'calc-eval		   "calc" "Use Calculator from Lisp")
(autoload 'defmath		   "calc" nil t t)
(autoload 'calc			   "calc" "Calculator Mode" t)
(autoload 'quick-calc		   "calc" "Quick Calculator" t)
(autoload 'calc-keypad		   "calc" "X windows Calculator" t)
(autoload 'calc-embedded	   "calc" "Use Calc inside any buffer" t)
(autoload 'calc-embedded-activate  "calc" "Activate =>'s in buffer" t)
(autoload 'calc-grab-region	   "calc" "Grab region of Calc data" t)
(autoload 'calc-grab-rectangle	   "calc" "Grab rectangle of data" t)
(global-set-key "\e#" 'calc-dispatch)
(global-set-key "" 'quick-calc)
;;; End of Calc autoloads.

(define-key ctl-x-map "\C-v" 'toggle-read-only)
(add-hook 'find-file-hooks '(lambda () (setq buffer-read-only t))) ;; this has to be before p4 to keep the read-only hook running last
;(if (y-or-n-p "Load p4 mode? ")
;    (load-library "p4"))

(load-library "checker-outline")
;21.3 (load-library "sum-schedule")
;21.3 (push '("" checker-outline-sum-tree) checker-outline-keybindings-list)
;21.3 (push '("" checker-outline-sum-level) checker-outline-keybindings-list)

; should make these parms machine/res dependent so I can share .emacs files
; 1280x1024 -> (top . 0) (left . 320) (width . 120) (height . 62)
; 800x600 -> (top . 0) (left . 94) (width . 80) (height . 35)
(setq initial-frame-alist '((top . 11) (left . 244) (width . 100) (height . 60) (scroll-bar-width . 2) (vertical-scroll-bars . right) (tool-bar-lines . 0)))

; (setq checker-text-color "light green") why doesn't this work? alists -> symbols?

(setq visible-bell t)
(setq diff-switches nil)

(setq default-frame-alist (append '((top . 11) (left . 260) (width . 115) (height . 61)) '((scroll-bar-width . 2) (vertical-scroll-bars . right) (menu-bar-lines . 0) (border-color . "black") (cursor-color . "light green") (mouse-color . "black") (background-color . "black") (foreground-color . "light green")  (tool-bar-lines . 0))))

(global-set-key [f6] '(lambda (buffer)
                        (interactive "bDelete process from buffer: ")
                        (delete-process buffer)))

(load-library "view")    
(setq-default truncate-lines t)
(setq mouse-wheel-progressive-speed nil)
(global-set-key [f5] '(lambda () (interactive) (setq truncate-lines (not truncate-lines))(redraw-display)))
(setq-default indent-tabs-mode nil)
(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.
 '(auto-show-mode t)
 '(c++-font-lock-extra-types (quote ("\\([iof]\\|str\\)+stream\\(buf\\)?" "ios" "string" "rope" "list" "slist" "deque" "vector" "bit_vector" "set" "multiset" "map" "multimap" "hash\\(_\\(m\\(ap\\|ulti\\(map\\|set\\)\\)\\|set\\)\\)?" "stack" "queue" "priority_queue" "type_info" "iterator" "const_iterator" "reverse_iterator" "const_reverse_iterator" "reference" "const_reference")))
 '(c-font-lock-extra-types (quote ("FILE" "Lisp_Object")))
 '(ibuffer-formats (quote ((mark modified read-only " " (name 30 30 :left :elide) " " (size 9 -1 :right) " " (mode 16 16 :left :elide) " " filename-and-process) (mark " " (name 16 -1) " " filename))))
 '(icicle-add-proxy-candidates-flag nil)
 '(icicle-apropos-cycle-next-keys (quote ([22] [next])))
 '(icicle-apropos-cycle-previous-keys (quote ([134217846] [prior])))
 '(icicle-command-abbrev-alist nil)
 '(icicle-reminder-prompt-flag 0)
 '(icicle-saved-completion-sets (quote (("spasm-source" . "c:/checker/dev/spore/cronus/Tools/Spasm/icicles-spasm-source.cache"))))
 '(tags-apropos-verbose t))
;(setq-default hscroll-step 1)
;(add-hook 'post-command-hook 'hscroll-point-visible)

(require 'browse-kill-ring)

(require 'compile)
(setq compilation-window-height 4)
;; override the broken compilation-set-window-height function to actually just set the window height
(defun compilation-set-window-height (window)
  (if compilation-window-height
      (save-excursion
        (let ((w (selected-window)))
          (unwind-protect
              (progn
                (select-window window)
                (enlarge-window (- compilation-window-height (window-height))))
            (select-window w))))))
;; doesn't seem to work? (define-key compilation-mode-map [return] 'compile)
(global-set-key [f7] '(lambda () (interactive) (compile compile-command)))
(add-hook 'compilation-mode-hook
          (lambda () (local-set-key "\C-cc" 'compile)))

(add-hook 'dired-load-hook
	  (function (lambda ()
		      (load "dired-x")
		      ;; Set dired-x global variables here.  For example:
		      ;; (setq dired-guess-shell-gnutar "gtar")
		      ;; (setq dired-x-hands-off-my-keys nil)
		      )))
(add-hook 'dired-mode-hook
          '(lambda ()
             (local-set-key [C-up] 'dired-up-directory)
             (local-set-key [C-down] 'dired-advertised-find-file)
             (local-set-key [C-left] 'dired-prev-dirline)
             (local-set-key [C-right] 'dired-next-dirline)
             (define-key dired-mode-map "e"
               '(lambda () (interactive)
                  (find-file-other-window (read-file-name 
                                           "Find file in other window: "
                                           (dired-current-directory)))))
             ))

(makunbound 'checker-c-tab-stop-list)
(defvar checker-c-tab-stop-list
  ((lambda ()
     (let ((count 120) (the-list ()))
       (while (> count 0)
         (setq the-list (cons count the-list))
         (setq count (- count 4)
               )
         )
       the-list
       )
     )
   )
  )

(require 'cc-mode)
(set-variable 'grep-command "grep -Hni ")

(load-library "haxe-mode")

(menu-bar-mode -1)
(tool-bar-mode -1)
(tooltip-mode -1)
(setq scroll-step 2)
(define-key global-map "" '(lambda () (interactive) (find-file-read-only "~/.emacs")))
;;(define-key global-map [(control f)] 'Control-X-prefix)  ;; should I move C-f back to forward-char so I'm more compatible? seems bad for my fingers...maybe some other C-x alternate?  C-;?
(define-key global-map [(control \;)] 'Control-X-prefix)
(define-key global-map [home] 'beginning-of-line)
(define-key global-map [end] 'end-of-line)
(define-key global-map [next] '(lambda () (interactive) (let ((col (current-column))) (scroll-up) (move-to-column col))))
(define-key global-map [prior] '(lambda () (interactive) (let ((col (current-column))) (scroll-down) (move-to-column col))))
(define-key global-map [C-home] 'beginning-of-buffer)
(define-key global-map [C-end] 'end-of-buffer)
(global-set-key "\M- " 'nil)
(global-set-key "\M-c" 'nil)
(global-set-key "\M-g" '(lambda (n) (interactive "nGoto line: ") (push-mark) (goto-line n)))
(global-set-key "g" '(lambda (n) (interactive "nGoto char: ") (push-mark) (goto-char n)))
(global-set-key "" '(lambda (n) (interactive "nGoto char: ") (push-mark) (goto-char n)))
(global-set-key "" '(lambda (n) (interactive "nGoto relative char: ") (push-mark) (goto-char (+ (point) n))))
;; (global-set-key '[27 return] '(lambda () (interactive) (pop-mark)))
;; (global-set-key '[27 C-return] 'View-back-to-mark)
(global-set-key "x" (quote eval-expression))

(global-set-key "i" 'imenu)
(global-set-key "	" 'imenu)
(global-set-key "." 'tags-search)
(global-set-key '[M-right] (lambda () (interactive) (find-tag last-tag t)))
(global-set-key '[M-left] (lambda () (interactive) (find-tag last-tag '-)))

(global-set-key "" (quote kill-word))
(global-set-key [C-tab] 'tab-to-tab-stop)
(global-set-key " " (quote set-mark-command))
(define-key ctl-x-map ";" 'indent-region)

(global-unset-key "\C-x\C-e")
(global-unset-key "\C-x\C-p")
(global-unset-key "\C-x\C-n")
(global-unset-key [mouse-2])
(global-unset-key "\C-x.")
(global-unset-key "\M-t")

(global-set-key '[M-down] 'other-window)
(global-set-key '[M-up] '(lambda () (interactive) (other-window -1)))
;;(global-set-key "\C-b" 'scroll-down)

(toggle-scroll-bar -1)

(setq enable-recursive-minibuffers t)
(add-hook 'minibuffer-setup-hook
      (function (lambda () 
		 (setq truncate-lines nil))))
(setq next-line-add-newlines nil)
(column-number-mode 1)
(setq auto-save-default nil
      make-backup-files nil)

; use the mark-setting ones and try it out
;(global-set-key "\M-<" '(lambda () (interactive) (goto-char (point-min))))
;(global-set-key "\M->" '(lambda () (interactive) (goto-char (point-max))))
(global-set-key [C-backspace] 'backward-kill-word)
(global-set-key (quote [27 C-backspace]) (quote backward-kill-word))
;(define-key ctl-x-map "\C-y" 'yank-pop)
(define-key ctl-x-map "\C-r" '(lambda () (interactive) (revert-buffer nil nil)))

;(define-key ctl-x-map "\C-f" 'find-file-read-only)
;(define-key ctl-x-map "\M-f" 'find-file)

(global-set-key "\M-g" 'goto-line)
(global-set-key "\M-r" 'replace-regexp)
(global-set-key "" (quote query-replace-regexp))

(defun top-of-window () (interactive) (move-to-window-line 0))
(defun bottom-of-window () (interactive) (move-to-window-line -1))
(defun make-top-of-window () (interactive) (recenter 0))
(defun make-bottom-of-window () (interactive) (recenter -1))
(global-set-key [C-prior] 'top-of-window)
(global-set-key "\C-x\C-b" 'top-of-window)
(global-set-key [C-next] 'bottom-of-window)
(global-set-key "\C-x\C-f" 'bottom-of-window)
(define-key ctl-x-map [C-prior] 'make-top-of-window)
(global-set-key "\C-x\C-p" 'make-top-of-window)
(define-key ctl-x-map [C-next] 'make-bottom-of-window)
(global-set-key "\C-x\C-n" 'make-bottom-of-window)



; @todo was trying to fix the HTML style problem with single quotes...
;; better movement routines for ThisStyleOfVariablesCommonInCPlusPlus
;; originally contributed by Terry_Glanfield.Southern@rxuk.xerox.com
(defun checker-forward-into-nomenclature (&optional arg)
  "Move forward to end of a nomenclature section or word. With arg, do it arg times."
  (interactive "p")
  (let ((case-fold-search nil))
    (if (> arg 0)
; try to avoid the symbol as word in syntax table problem
;	(re-search-forward "\\W*\\([A-Z]*[a-z0-9]*\\)" (point-max) t arg)
	(re-search-forward "\\W*\\([A-Z_]*['%a-z0-9]*\\)" (point-max) t arg)
;	(re-search-forward "\\W*\\([A-Z]*\w*\\)" (point-max) t arg)
      (while (and (< arg 0)
		  (re-search-backward
		   "\\(\\(\\W\\|[a-z0-9]\\)[A-Z]+\\|\\W\\w+\\)"
		   (point-min) 0))
	(forward-char 1)
	(setq arg (1+ arg)))))
  )

(defun checker-backward-into-nomenclature (&optional arg)
  "Move backward to beginning of a nomenclature section or word. With optional ARG, move that many times.  If ARG is negative, move forward."
  (interactive "p")
  (checker-forward-into-nomenclature (- arg))
  )

(global-set-key [C-left] 'checker-backward-into-nomenclature)
(global-set-key [C-right] 'checker-forward-into-nomenclature)

(put 'eval-expression 'disabled nil)
(require 'matlab)
(setq auto-mode-alist
      (append
       '(
         ("\\.m$" . matlab-mode)
         ("\\.dtx$"    . TeX-mode)
         )
       auto-mode-alist))

(setq auto-mode-alist
      (append
       '(("\\.cpp$"    . c++-mode)
	 ("\\.h$"    . c++-mode)
	 ("\\.c$"   . c++-mode)
	 ("\\.cc$"   . c++-mode)
	 ) auto-mode-alist))

(setq checker-tab-width 4) ;; (if (y-or-n-p "3 stop tabs?") 3 4))
(defconst checker-c-style
  '((c-electric-pound-behavior   . nil)
    (c-tab-always-indent         . 1)
    (c-comment-only-line-offset  . 0)
    (c-hanging-braces-alist      . ((class-open)
                                    (class-close)
                                    (defun-open)
                                    (defun-close)
                                    (inline-open)
                                    (inline-close)
                                    (brace-list-open)
                                    (brace-list-close)
                                    (brace-list-intro)
                                    (brace-list-entry)
                                    (block-open)
                                    (block-close)
                                    (substatement-open)
                                    (statement-case-open)
                                    (class-open)))
    (c-hanging-colons-alist      . ((inher-intro)
                                    (case-label)
                                    (label)
                                    (access-label)
                                    (access-key)
                                    (member-init-intro)))
    (c-cleanup-list              . (scope-operator
                                    list-close-comma
                                    defun-close-semi))
    (c-offsets-alist             . ((arglist-close         . c-lineup-arglist)
                                    (arglist-cont          .  0)
                                    (label                 . (- checker-tab-width))
                                    (brace-list-open       .  0)
                                    (topmost-intro-cont    .  checker-tab-width)
                                    (access-label          . (- checker-tab-width))
                                    (substatement          .  checker-tab-width)
                                    (substatement-open     .  0)
                                    (statement-case-intro  .  checker-tab-width)
                                    (statement-block-intro .  checker-tab-width)
                                    (case-label            .  checker-tab-width)
                                    (block-open            .  0)
                                    (innamespace           .  0)
                                    (inextern-lang         .  0)
                                    (knr-argdecl-intro     . (- checker-tab-width))))
    (c-echo-syntactic-information-p . t))
    "checker's cc-mode style")

;; font-lock global color schemes
(load-library "font-lock")
(global-font-lock-mode t)
(defun clear-face (face &optional foreground-color)
  "clear a face to a single foreground color"
  (set-face-background face nil)
  (set-face-font face nil)
  (if foreground-color
      (set-face-foreground face foreground-color)))

; fix a bug in the dired font-lock stuff
(setq dired-font-lock-keywords
      '(("^. \\([^\n
]+\\)\\(:\\)[\n
]"
         (1 font-lock-type-face))
;;        ("\\.cpp$"
;;         (1 font-lock-keyword-face))
        ("^[^ \n]"
         (0 font-lock-constant-face)
         (".+"
          (dired-move-to-filename)
          nil
          (0 font-lock-warning-face)))
        ("^. [0-9 	]*d[^:]"
         (".+"
          (dired-move-to-filename)
          nil
          (0 font-lock-function-name-face)))
        ("^. [0-9 	]*l[^:]"
         (".+"
          (dired-move-to-filename)
          nil
          (0 font-lock-keyword-face)))))
;; 21.3 (clear-face 'font-lock-warning-face "gold")

(defun checker-display-colors ()
  (interactive)
  ;; (set-face-foreground 'default "light green")
  ;; (set-face-background 'default "black")
  (set-cursor-color "light green")
  (set-foreground-color "light green")
  (set-background-color "black")
  (set-face-background 'region "blue")
  (set-face-foreground 'highlight "black")
  (set-face-background 'highlight "light green")
  (set-face-foreground 'modeline "black")
  (set-face-background 'modeline "light green")
  (set-face-foreground font-lock-function-name-face "light gray")
  (set-face-foreground font-lock-comment-face "LightSkyBlue2")
  (set-face-foreground font-lock-string-face "turquoise2")
  (set-face-foreground font-lock-keyword-face "cornflower blue")
  (set-face-foreground font-lock-type-face "deep sky blue")
  (set-face-foreground font-lock-constant-face "Aquamarine")
  (set-face-foreground font-lock-variable-name-face "LightGoldenrod")
  (set-face-foreground 'checker-dark-grey-face "gray20")
  (set-face-foreground 'checker-light-grey-face "gray50")
  (set-face-foreground 'font-lock-warning-face "Pink")
  )

(defun checker-printing-colors ()
  (interactive)
  (set-cursor-color "light green")
  (set-foreground-color "black")
  (set-background-color "white")
  (set-face-background 'region "blue")
  (set-face-foreground 'highlight "black")
  (set-face-background 'highlight "light green")
  (set-face-foreground 'modeline "black")
  (set-face-background 'modeline "light green")
  (set-face-foreground 'font-lock-warning-face "Red")
  (set-face-foreground font-lock-variable-name-face "NavyBlue")
  (set-face-foreground font-lock-constant-face "DarkGreen")
  (set-face-foreground font-lock-string-face "SaddleBrown")
  (set-face-foreground font-lock-type-face "DarkGoldenrod")
  (set-face-foreground font-lock-function-name-face "light gray")
  (set-face-foreground font-lock-comment-face "LightSkyBlue2")
  (set-face-foreground font-lock-keyword-face "cornflower blue")
  (set-face-foreground 'checker-dark-grey-face "gray20")
  (set-face-foreground 'checker-light-grey-face "gray50")
  )
(checker-display-colors)
;;(checker-printing-colors)


(defun checker-c-hook ()
  (c-add-style "checker" checker-c-style t)
  (setq tab-width checker-tab-width indent-tabs-mode nil)
  (setq c-basic-offset checker-tab-width)
  (c-set-offset 'member-init-intro '++)
  (c-toggle-auto-hungry-state -1)
  (define-key c-mode-base-map "\C-m" 'newline-and-indent)
  (make-local-variable 'tab-stop-list)
  (setq tab-stop-list checker-c-tab-stop-list)
  (define-key c-mode-base-map [M-tab] 'fixup-whitespace)
  (define-key c-mode-base-map "	" (quote fixup-whitespace))
  (define-key ctl-x-map [C-up]  'c-beginning-of-defun)
  (define-key ctl-x-map [C-down] 'c-end-of-defun)
  (define-key ctl-x-map "\C-p"  'c-beginning-of-defun)
  (define-key ctl-x-map "\C-n" 'c-end-of-defun)
  (setq c-hanging-semi&comma-criteria '((lambda () 'stop)))
  (c-subword-mode 1)
  (abbrev-mode 1)
  (setq c-tab-always-indent t)
)

(add-hook 'c-mode-common-hook 'checker-c-hook)

(setq auto-mode-alist
      (append '(("\\.\\([pP][Llm]\\|al\\)\\'" . perl-mode)
                ("\\.cgi" . perl-mode))
              auto-mode-alist))
(require 'cperl-mode)
(add-hook 'perl-mode-hook 
          '(lambda ()
             (local-set-key [return] 'newline-and-indent)
             )
          )



;;(add-hook 'perl-mode-hook (lambda () (setq perl-continued-brace-offset 0)))
                            
(define-key lisp-mode-shared-map "\C-x\C-e" 'eval-last-sexp)
(define-key lisp-mode-shared-map [return] 'newline-and-indent) ;; 21.3
(define-key lisp-mode-shared-map [linefeed] 'eval-print-last-sexp) ;; 21.3
(define-key emacs-lisp-mode-map [linefeed] 'eval-print-last-sexp)

;;(global-set-key "\M--" 
;;                '(lambda () (interactive)
;;                   (insert "/*----------------------------------------------------------------------------\n\n")))

(defun noclass-copy (class-name)
  (interactive "sEnter class-name: ")
  (insert "// prevent copying")
  (newline-and-indent)
  (insert class-name "( " class-name " const & );")
  (newline-and-indent)
  (insert class-name " &operator=( " class-name " const & );" ))

(defun c-separator-comment (comment)
  (interactive "sEnter comment: ")
  (let* ((tw 78)
         (cw (+ 2 (length comment)))
         (sw (/ (- tw 2 cw) 2))
         (ss (make-string sw ?*))
         (ess (make-string (logand cw 1) ?*)))
    (beginning-of-line)
    (insert (format "/%s %s %s%s/" ss comment ss ess))))

(defun shell-command-on-buffer (command &optional output-buffer replace)
  "invoke command with current buffer as input...see shell-command-on-region\n"
  (interactive
   (let ((string (read-string (format "Shell command on buffer%s: "
				      (if (and (boundp 'shell-command-on-buffer-last-command)
					       (not (string= shell-command-on-buffer-last-command "")))
					  (format " (default %s)" shell-command-on-buffer-last-command)
					(setq shell-command-on-buffer-last-command ""))))))
     (list string)))
  (if (string= command "")
      (setq command shell-command-on-buffer-last-command)
    (setq shell-command-on-buffer-last-command command))
  (if current-prefix-arg
      (setq output-buffer current-prefix-arg))
  (;;message (format "%s %s %s %s %s" ;;
   shell-command-on-region
   (point-min) (point-max) command output-buffer replace))

(global-set-key "|" 'shell-command-on-buffer)
  
;; this is ripped from paren.el...I can't believe this isn't built in
(defun goto-matching-fence ()
  (interactive)
  (let (pos dir (mismatch t) (oldpos (point)))
    (cond ((eq (char-syntax (following-char)) ?\))
	   (setq dir -1)
	   (setq oldpos (+ oldpos 1)))
	  ((eq (char-syntax (following-char)) ?\()
	   (setq dir 1)))
    (if dir
	(progn
	  (save-excursion
	    (save-restriction
              ;; Scan across one sexp within that range.
	      (condition-case ()
		  (setq pos (scan-sexps oldpos dir))
		(error nil))
              ;; See if the "matching" paren is the right kind of paren
              ;; to match the one we started at.
	      (if pos
		  (let ((beg (min pos oldpos)) (end (max pos oldpos)))
		    (and (/= (char-syntax (char-after beg)) ?\$)
			 (setq mismatch
			       (not (eq (char-after (1- end))
                                        ;; This can give nil.
					(matching-paren (char-after beg))))))))
		)
	      )
	    )
	  )
    ;; If they don't properly match, use a different face,
    ;; or print a message.
    (if mismatch
		  (message "Paren mismatch")
      (progn (push-mark)
	     (cond ((eq dir 1)
		    (goto-char (- pos 1)))
		   ((eq dir -1)
		    (goto-char pos))))
      )
    )
  )
(global-set-key "f" 'goto-matching-fence)

(setq archive-zip-use-pkzip nil)

;;; Objective Caml mode
;(setq auto-mode-alist (cons '("\\.ml\\w?" . tuareg-mode) auto-mode-alist))
;(autoload 'tuareg-mode "tuareg" "Major mode for editing Caml code" t)
;(autoload 'camldebug "camldebug" "Run the Caml debugger" t)
(setq auto-mode-alist (cons '("\\.ml[iylp]?$" . caml-mode) auto-mode-alist))
(autoload 'caml-mode "caml" "Major mode for editing Caml code." t)
(autoload 'run-caml "inf-caml" "Run an inferior Caml process." t)
(setq inferior-caml-program "ocaml")
(require 'caml-font)
;; (defun caml-comment-line () "[un]comment line"
;;   (interactive)
;;   (save-excursion
;;     (let ((bol (line-beginning-position))
;;           (eol (line-end-position)))
;;       (beginning-of-line)
;;       (re-search-forward "^\\s- *(\\*\\("

(add-hook 'caml-mode-hook
          '(lambda ()
             (local-set-key [return] 'newline-and-indent)
             (define-key caml-mode-map [C-tab] 'tab-to-tab-stop)
             (define-key caml-mode-map "\C-c\C-t"
               (lambda ()
                 "Eval the entire buffer with *inferior-caml*"
                 (interactive)
                 (inferior-caml-eval-region (point-min) (point-max))))
             (setq case-fold-search t)
;; @todo gotta get this working with outline-minor-mode
;;             (outline-mode)
;;             (setq outline-use-mode-specific-leader "")
;;             (setq outline-header-prefix "   ")  ;; caml toplevel comment
;;             (set-outline-regexp)
;;             (auto-fill-mode -1)
             ))


(put 'narrow-to-region 'disabled nil)

;;(defun multi-string-match (str &rest re)
;; how to do a nway 'or'  (string-match re str))

;;; xml mode
;; Tell emacs to use sgml/xml mode for the following file types.
(setq auto-mode-alist
      (append '(
                ;;       ("\\.sgm" . sgml-mode)
                ;;         ("\\.sgml" . sgml-mode)
                ("\\.swfml" . xml-mode)
                ;;         ("\\.xsl" . xml-mode)
                ) auto-mode-alist))
;;(autoload 'sgml-mode "psgml" "Major mode to edit SGML files." t)
;;(autoload 'xml-mode "psgml" "Major mode to edit XML files." t)
(defun sgml-am-i-in-text ()
  "Check if the point is in editable text (#PCDATA, comment, inside a
tag, etc.) or in just \"in the document somewhere\".  Hacked from
sgml-show-context."
  (let* ((el (sgml-last-element))
	 (model (sgml-element-model el))
         (res (cond
               (sgml-markup-type)
               ((sgml-element-mixed el)
                'PCDATA)
               ((not (sgml-model-group-p model))
                model)
               (t 'NOWHERE))))
    (if (or (eq res 'comment)
            (eq res 'PCDATA)
            (eq res 'CDATA)
            (eq res 'RCDATA))
        t
      nil)))

(defvar checker-do-eval-sgml-nav-key nil
  "*non-nil means dynamically eval nav keys in sgml buffers")
(defmacro checker-eval-sgml-nav-key (key-seq sgml-fun)
  `(local-set-key ,key-seq
                  '(lambda (&optional arg)
                     (interactive "p")
                     (if (or (sgml-am-i-in-text)
                             (not checker-do-eval-sgml-nav-key))
                         (apply (global-key-binding ,key-seq) (list arg))
                       (,sgml-fun)))))
;;(add-hook 'sgml-mode-hook
;;          (lambda ()
;;            (setq sgml-indent-data t)
;;            (define-key sgml-mode-map "\C-c\C-f" 'sgml-fold-element)
;;            (define-key xml-mode-map "\C-c," 'sgml-insert-tag)
;;            (checker-eval-sgml-nav-key [C-right] sgml-forward-element)
;;            (checker-eval-sgml-nav-key [C-left] sgml-backward-element)
;;            (checker-eval-sgml-nav-key [C-up] sgml-backward-up-element)
;;            (checker-eval-sgml-nav-key [C-down] sgml-down-element)
;;            ))

;; Create some faces for use with sgml/xml mode.
;; Change colors to suite your fancy.
(make-face 'sgml-start-tag-face) 
(set-face-foreground 'sgml-start-tag-face "MediumSeaGreen")
(make-face 'sgml-attrib-face) 
(set-face-foreground 'sgml-attrib-face "white")  ;; @todo doesn't work???
(make-face 'sgml-end-tag-face) 
(set-face-foreground 'sgml-end-tag-face "SeaGreen") 
(make-face 'sgml-entity-face) 
(set-face-foreground 'sgml-entity-face "tan") 
(make-face 'sgml-doctype-face) 
(set-face-foreground 'sgml-doctype-face "firebrick") 
(make-face 'sgml-comment-face) 
(set-face-foreground 'sgml-comment-face "blue") 

; Use faces defined above.
(setq sgml-set-face t)
(setq sgml-markup-faces 
      '((comment   . sgml-comment-face) 
        (start-tag . sgml-start-tag-face) 
        (attrib    . sgml-attrib-face) 
        (end-tag   . sgml-end-tag-face) 
        (doctype   . sgml-doctype-face) 
        (entity    . sgml-entity-face)))


(require 'ediff)
(require 'ibuffer)
(define-key global-map "\C-x\C-b" 'ibuffer)

(defun cmu-ediff-setup-windows (buffer-A buffer-B buffer-C control-buffer)
  (ediff-setup-windows-plain buffer-A buffer-B buffer-C control-buffer)
)
(setq ediff-window-setup-function 'cmu-ediff-setup-windows)
(setq ediff-split-window-function 'split-window-horizontally)


; And if you want PCL (read the NT Emacs FAQ on how to get it)...
;(require 'pcl-cvs)
;(load "pcl-cvs-startup.el")
;(setq cvs-auto-remove-handled t)


;; smtpmail
(setq user-full-name "Chris Hecker")
(setq user-mail-address "checker@d6.com")
(setq mail-aliases t)
(add-hook 'mail-setup-hook
          (lambda () (auto-fill-mode 1)))

; Note that if you want to change the name of the smtp server after
; you've loaded smtpmail.el, you'll want to change the variable
; smtpmail-smtp-server.
(setq send-mail-function 'smtpmail-send-it)
(setq smtpmail-default-smtp-server "plink.bolt-action.com")
(setq smtpmail-smtp-service "smtp")
(setq smtpmail-local-domain nil)
(load-library "smtpmail")
(setq smtpmail-code-conv-from nil)
(setq smtpmail-debug-info t)


;If you are using GNUS to send mail, then you will also need: 
(load-library "message")
(setq message-send-mail-function 'smtpmail-send-it)

(defun delete-frame-and-kill-buffer ()
  "Delete the currently selected frame and buffer."
  (interactive)
  (kill-buffer nil)
  (delete-frame))
(define-key ctl-x-5-map "k" 'delete-frame-and-kill-buffer)

(defun simple-paren-indent-line-function ()
  (let* ((col-add 3)
         (cur-pos (point))
         (cur-marker (point-marker))
         (parse-list (parse-partial-sexp 1 (line-beginning-position)))
         (paren-idx (nth 1 parse-list))
         (string-idx (nth 8 parse-list))
         (in-string (nth 3 parse-list))
         (open-paren (if string-idx string-idx (if paren-idx paren-idx 0)))
         targ-col col-diff targ-bol cur-bol indent-done)
    (if (/= open-paren 0)
        (progn
          (save-excursion
            (goto-char open-paren)
            (setq targ-col (current-column))
            (goto-char cur-pos)
            (beginning-of-line)
            (cond
             (in-string
              (if (not (re-search-forward "^\\s-*\\s\"" (line-end-position) t))
                  ;; we're in a string, but not alone on a line, so indent to the first character
                  (setq targ-col (+ targ-col 1))))
             
             ((not (re-search-forward "^\\s-*\\s)" (line-end-position) t))
              ;; we're not on the empty close paren, so indent us all the way
              (setq targ-col (+ targ-col col-add)))
             )
            )
          (if (not indent-done)
              (progn
                (indent-line-to targ-col)
                (setq col-diff (- (marker-position cur-marker) (point)))
                (if (> col-diff 0)
                    (goto-char (+ (point) col-diff)))
                )
            )
          )
      (indent-line-to 0)
      (goto-char cur-marker)
      )
    (set-marker cur-marker nil)
    )
  )


(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.
 '(cperl-array-face ((t (:bold nil :foreground "medium violet red"))))
 '(cperl-hash-face ((t (:bold nil :foreground "yellow green"))))
 '(cperl-nonoverridable-face ((t (:bold nil :foreground "orchid3"))))
 '(diff-added ((t (:foreground "green"))))
 '(diff-removed ((t (:foreground "red3")))))

(defvar checker-ediff-revision-window-configuration nil "emacs doesn't support real closures or this could be local")
(defun checker-ediff-revision ()
  "Use ediff for version diffs."
  (interactive)
  (vc-ensure-vc-buffer)
  (let ((file buffer-file-name))
    (setq checker-ediff-revision-window-configuration (current-window-configuration))
    (ediff-revision file
                    (list 
                     '(lambda ()
                        (make-local-hook 'ediff-cleanup-hook)
                        (add-hook 'ediff-cleanup-hook
                                  '(lambda (&optional ask)
                                     (or (not (ediff-buffer-live-p ediff-buffer-A))
                                         (buffer-modified-p ediff-buffer-A)
                                         (and ask
                                              (not (y-or-n-p (format "Kill buffer A [%s]? "
                                                                     (buffer-name ediff-buffer-A)))))
                                         (ediff-kill-buffer-carefully ediff-buffer-A))
                                     )
                                  nil t) ;; prepend local
                        (make-local-hook 'ediff-quit-hook)
                        (add-hook 'ediff-quit-hook
                                  '(lambda ()
                                     (set-window-configuration checker-ediff-revision-window-configuration)
                                     (setq checker-ediff-revision-window-configuration nil)
                                     )
                                  t t) ;; append local
                        )
                     )
                    )
    )
  )
(define-key vc-prefix-map "e" 'checker-ediff-revision)
(setq vc-cvs-stay-local nil)

;; this version prompts for a file name
;; (defun checker-ediff-revision (&optional file)
;;   (interactive
;;    (list (let ((fname))
;;            (while (or (not fname) (not (file-regular-p fname)))
;;              (setq fname (read-file-name (format "File%s: "
;;                                                  (if buffer-file-name
;;                                                      (format " (default %s)" (file-name-nondirectory buffer-file-name))
;;                                                    "")) fname fname t))
;;              (if (not (file-regular-p fname))
;;                  (progn
;;                    (ding)
;;                    (message "must be a file")
;;                    (sit-for 1)
;;                    ))
;;              )
;;            fname)
;;     )
;;    )
;;   (setq checker-ediff-revision-window-configuration (current-window-configuration))
;;   (ediff-revision file
;;                   (list 
;;                    '(lambda ()
;;                       (make-local-hook 'ediff-cleanup-hook)
;;                       (add-hook 'ediff-cleanup-hook
;;                                 '(lambda (&optional ask)
;;                                    (or (not (ediff-buffer-live-p ediff-buffer-A))
;;                                        (buffer-modified-p ediff-buffer-A)
;;                                        (and ask
;;                                             (not (y-or-n-p (format "Kill buffer A [%s]? "
;;                                                                    (buffer-name ediff-buffer-A)))))
;;                                        (ediff-kill-buffer-carefully ediff-buffer-A))
;;                                    )
;;                                 nil t) ;; prepend local
;;                       (make-local-hook 'ediff-quit-hook)
;;                       (add-hook 'ediff-quit-hook
;;                                 '(lambda ()
;;                                    (set-window-configuration checker-ediff-revision-window-configuration)
;;                                    (setq checker-ediff-revision-window-configuration nil)
;;                                    )
;;                                 t t) ;; append local
;;                       )
;;                    )
;;                   )
;;   )

(require 'pfx-mode)
(require 'mel-mode)
;21.3 (require 'lua-mode)

;; calc functions
(defmath dot (a b)
  (* a b))
(defmath fnv1-hash (str)
  (let ((hash  :"16#811c9dc5")
        (prime :"16#01000193")
        (lstr (downcase str))
        (i 0)
        (n (length str)))
    (while (< i n)
      (setq hash (clip (* hash prime) 32))
      (setq hash (xor hash (aref lstr i)))
      (setq i (+ i 1))
      )
    hash
    )
  )
(defun string-spid (str)
  (let ((hash (calcFunc-fnv1-hash str))
        (calc-number-radix 16)
        (calc-word-size 32)
        (calc-leading-zeros t))
    (math-format-value hash)
    )
  )
(defun spid (str)
  (interactive "sString to hash: ")
  (let ((id (string-spid str)))
    (kill-new id)
    (message id))
  )
(defun spid-region (start end)
  (interactive "r")
  (let* ((str (buffer-substring start end))
         (hash (calcFunc-fnv1-hash str))
         (calc-number-radix 16)
         (calc-word-size 32)
         (calc-leading-zeros t)
         (hex (math-format-value hash)))
    (string-match "16#\\(........\\)" hex)
    (delete-region start end)
    (push-mark nil)
    (insert (format "0x%s /* %s */" (match-string 1 hex) str))
    )
  )
(defmath spguid-raw ()
  (calcFunc-and (clip (- (unixtime (now)) (unixtime :"<Jan 1, 2005>")) 32) :"16#7FFFFFFF"))
;;(defmath spguid-raw ()
;;  (let ((time (current-time))
;;        (base-time (encode-time 0 0 0 1 1 2005)) ;; January 1, 2005
;;        secs base)
;;    (setq base (+ (* (^ 2 16) (nth 0 base-time)) (nth 1 base-time)))
;;    (setq secs (+ (* (^ 2 16) (nth 0 time)) (nth 1 time)))
;;    (calcFunc-and (clip (- secs base) 32) :"16#7FFFFFFF")
;;    )
;;  )
(defun spguid ()
  (interactive)
  (let* ((guid (calcFunc-spguid-raw))
         (calc-number-radix 16)
         (calc-word-size 32)
         (calc-leading-zeros t)
         (hex (math-format-value guid)))
    (string-match "16#\\(........\\)" hex)
    (push-mark nil)
    (insert (format "0x%s" (match-string 1 hex)))
    )
  )


;; disable old completion stuff since I switched to the awesome icicles
(and nil
     (progn
       (partial-completion-mode)
       (require 'ido)
       (ido-mode t)
       (setq ido-default-file-method 'samewindow)
       (setq ido-default-buffer-method 'samewindow)
       (setq completion-ignored-extensions nil)
       (load-library "cycle-mini")    ; should byte-compile this file!
       (define-key minibuffer-local-completion-map " " 'cycle-mini-next-completion)
       (define-key minibuffer-local-must-match-map " " 'cycle-mini-next-completion)
       ))

; (setq load-path (append '("~/lisp/icicles") load-path))
(setq icicle-define-alias-commands-flag nil)        ;; auctex doesn't like the file aliases
(require 'icicles) ; Load this library.
(icicle-mode 1)    ; Turn on Icicle mode.
(setq icicle-incremental-completion-flag 'always)   ;; always show completion buffer...
(setq icicle-incremental-completion-delay 0)        ;; ...with no delay...
(setq icicle-Completions-display-min-input-chars 2) ;; ...but only after two characters have been typed
(defun icicle-region-or-buffer-limits () "Override to force whole buffer." (list (point-min) (point-max)))
; turn off stupid icicles line stuff
(let ((maps (list 
             minibuffer-local-map minibuffer-local-ns-map minibuffer-local-isearch-map
             completion-list-mode-map minibuffer-local-completion-map minibuffer-local-must-match-map)))
  (mapcar '(lambda (map) (progn
                           (define-key map [(control ?a)] 'move-beginning-of-line)
                           (define-key map [(control ?e)] 'move-end-of-line)))
          maps))
 
(setq dabbrev-case-replace nil)
(setq dabbrev-case-fold-search t)
(setq dabbrev-upcase-means-case-search t)
(global-set-key [?\M-\C-/] 'icicle-dabbrev-completion)

(defun p4edit () "p4 edit buffer-file-name" (interactive) (call-process "p4.bat" nil "*Shell Command Output*" t "edit" buffer-file-name))

; (setq icicle-buffer-require-match-flag 'partial-match-ok)  ;; really want C-j behavior, hmm

;(global-set-key "\M-e" 'edebug-defun)
;(global-set-key "\M-E" 'edebug-all-defs)

;;;;;;;;;;
;; the end