;;;  Copyright (c) 2004-2007 bivio Software, Inc.  All rights reserved.
;;; 
;;;  Visit http://www.bivio.biz for more info.
;;;  
;;;  This library is free software; you can redistribute it and/or modify
;;;  it under the terms of the GNU Lesser General Public License as
;;;  published by the Free Software Foundation; either version 2.1 of the
;;;  License, or (at your option) any later version.
;;;  
;;;  This library is distributed in the hope that it will be useful, but
;;;  WITHOUT ANY WARRANTY; without even the implied warranty of
;;;  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
;;;  Lesser General Public License for more details.
;;;  
;;;  You should have received a copy of the GNU Lesser General Public
;;;  License along with this library;  If not, you may get a copy from:
;;;  http://www.opensource.org/licenses/lgpl-license.html
;;;  
;;;  $Id: b-site-start.el,v 1.42 2011/09/22 16:07:50 nagler Exp $
;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; You will need to define a few variables after this file is
;;; loaded.  Search for the word "YOUR" in all upper-case.
;;;
(provide 'b-site-start)
(load-library "b-perl")
(load-library "b-hours")
(require 'sgml-mode)
(require 'compile)
(require 'cc-mode)
(require 'comint)

(global-font-lock-mode t)
(setq
 next-line-add-newlines nil
 case-replace t
 case-fold-search t
 visible-bell t
 highlight-nonselected-windows nil
 term-term-name "eterm"
 ring-bell-function 'ignore
 truncate-partial-width-windows nil
 completion-ignore-case t
 read-file-name-completion-ignore-case t
 read-buffer-completion-ignore-case t
 large-file-warning-threshold 100000000)
(unless window-system
  (progn
    (if (string-match "^21" emacs-version)
	(set-keyboard-coding-system nil))
    (setq visible-bell nil)))
;;; This show you what you've selected with the mouse
(transient-mark-mode t)
;; accelerate scrolling when the mouse gets dragged beyond the edge of a window
(if (string-equal system-type "darwin")
    (progn
      (setq mouse-scroll-delay 0.1)
      (if (functionp 'server-force-delete)
	  (server-force-delete))
      (server-start)
      (global-set-key [?\A-S] 'write-file)
      (global-set-key [?\A-a] 'mark-whole-buffer)
      (global-set-key [?\A-c] 'clipboard-kill-ring-save)
      (global-set-key [?\A-f] 'isearch-forward)
      (global-set-key [?\A-l] 'goto-line)
      (global-set-key [?\A-n] 'new-frame)
      (global-set-key [?\A-o] 'find-file)
      (global-set-key [?\A-q] 'save-buffers-kill-emacs)
      (global-set-key [?\A-s] 'save-buffer)
      (global-set-key [?\A-v] 'clipboard-yank)
      (global-set-key [?\A-x] 'clipboard-kill-region)
      (global-set-key [?\A-z] 'undo))
  (if (string-equal system-type "windows-nt")
      (progn
	(setq x-select-enable-clipboard t)
	(if (load "gnuserv" 'noerror 'nomessage)
	    (progn
	      (gnuserv-start)
	      (setq gnuserv-frame (selected-frame)))
	  ))
    (progn
      (server-start)
      ;; Setting this to true does not allow pasting between emacs and
      ;; normal windows.
      (setq x-select-enable-clipboard nil))))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;
;;; abbrevs.el (load if exists)
;;;
(condition-case nil
    (quietly-read-abbrev-file)
  (error nil))
; Bind some keys so people know they are there...
(define-key ctl-x-map "ae" 'edit-abbrevs)
; We want to actually write the file each time.  It is a cleaner model
; for the user.
(define-key edit-abbrevs-map "\C-c\C-c" 'save-abbrevs-redefine)
(define-key edit-abbrevs-map "\C-x\C-s" 'save-abbrevs-redefine)
(defun save-abbrevs-redefine ()
  "Redefine abbrevs according to current buffer contents and save."
  (interactive)
  (edit-abbrevs-redefine)
  (write-abbrev-file abbrev-file-name)
  (setq abbrevs-changed nil))


;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;
;;; compile.el fixes
;;;
(eval-after-load
 "compile"
 '(setq compilation-error-regexp-alist
	(append
	 '((".*at \\([^ ]+\\) line \\([0-9]+\\)\\.?\n" 1 2)) ; Support perl
	 compilation-error-regexp-alist)))

(add-hook 'mail-setup-hook 'mail-abbrevs-setup)
(setq mail-self-blind t)


(put 'eval-expression 'disabled nil)
(put 'narrow-to-region 'disabled nil)
(setq visible-bell t)
(setq indent-line-function 'indent-relative-maybe)

;; some file name extensions
(load "sgml-mode")

;; Delete unwanted auto-modes
(setq interpreter-mode-alist nil)
(mapcar '(lambda (mode)
	   (let ((x))
	     ; Delete all occurances
	     (while (setq x (rassoc mode auto-mode-alist))
	       (setq auto-mode-alist (delq x auto-mode-alist)))))
	'(tcl-mode
	  sh-mode
	  nroff-mode))

(add-hook 'text-mode-hook
	  '(lambda ()
	     (abbrev-mode t)
	     (define-key text-mode-map "\C-c|"
	       (lambda () "insert change bar at end of line"
		 (interactive)
		 (end-of-line)
		 (if (< (current-column) fill-column)
		     (move-to-column fill-column t)
		   (insert " "))
		 (insert "|")
		 (forward-line)))
	     (turn-on-auto-fill)))

(setq dabbrev-case-fold-search t)
(setq dabbrev-case-replace nil)
(setq dabbrev-abbrev-char-regexp "\\sw\\|\\s_")

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;
;;;; C
;;;;
(add-hook 'java-mode-hook
	  '(lambda ()
	     (c-set-style "RGI")
	     (make-local-variable 'compile-command)
	     (setq compile-command
		   (concat (if (getenv "JAVAC") (getenv "JAVAC") "javac")
			   " " 
			   (if (getenv "JAVAC_FLAGS")
			       (getenv "JAVAC_FLAGS") "-g")
			   " "
			   (file-name-nondirectory buffer-file-name)))
	     (cond (window-system
		    (require 'andersl-java-font-lock)
		    (turn-on-font-lock)))))
(setq font-lock-maximum-decoration t)

(add-hook 'c-mode-common-hook
	  '(lambda ()
	     (setq fill-column 79)
	     (setq c-tab-always-indent nil)
	     (setq c-echo-syntactic-information-p t)
	     (modify-syntax-entry ?_  "w"  c-mode-syntax-table)
	     (c-toggle-auto-state +1)
	     (c-toggle-hungry-state -1)
	     (auto-fill-mode +1)
	     (abbrev-mode t)
	     ))

(modify-syntax-entry ?_  "w"  c-mode-syntax-table)
(modify-syntax-entry ?$  "w"  java-mode-syntax-table)
(define-key c-mode-map "\C-c\C-c" 'next-error)
(define-key c-mode-map "\C-c\C-m" 'compile)
(define-key c-mode-map "\C-c\C-f" 'auto-fill-mode)
(define-key c-mode-map "\C-m"     'newline-and-indent)
(define-key c-mode-base-map "\C-c;" 'c-right-justify-comment)
(define-key c-mode-base-map "\C-c," 'c-align-decls)
(define-key c-mode-base-map "\C-c\C-m" 'compile)
(define-key c-mode-base-map "\C-c\C-m" 'compile)
(define-key c-mode-base-map "\C-c\C-e" 'next-error)
(define-key java-mode-map "\C-c<" 
  (lambda () "insert &lt;" (interactive) (insert "&lt;")))
(define-key java-mode-map "\C-c>" 
  (lambda () "insert &gt;" (interactive) (insert "&gt;")))
(define-key java-mode-map "\C-c " 
  (lambda () "insert &nbsp;" (interactive) (insert "&nbsp;")))
(define-key java-mode-map "\C-c\n" 
  (lambda () "insert <br>" (interactive)
    (insert "<br>") (newline-and-indent)))
(define-key java-mode-map "\C-ct" 
  (lambda () "insert <tt>" (interactive) (sgml-tag "tt")))
(define-key java-mode-map "\C-cp" 
  (lambda () "insert <p>" (interactive)
    (insert "<p>") (newline-and-indent) (newline-and-indent)))
(define-key java-mode-map "\C-cs" 
  (lambda () "insert <tt>" (interactive) (sgml-tag "strong")))
(define-key java-mode-map "\C-ci" 
  (lambda () "insert <tt>" (interactive) (sgml-tag "em")))
(define-key java-mode-map "\C-cx" 
  (lambda () "insert <blockquote><pre>" (interactive)
	(newline-and-indent)
	(insert "<blockquote><pre>")
	(newline-and-indent)
	(insert "</pre></blockquote>")
	(forward-line -1)
	(end-of-line)
	(newline-and-indent)))
(define-key java-mode-map "\C-ch" 
  (lambda () "insert <p><strong>" (interactive)
	(newline-and-indent)
	(insert "<p><strong>")
	(newline-and-indent)
	(insert "</strong><p>")
	(forward-line -1)
	(end-of-line)
	(newline-and-indent)))
(define-key java-mode-map "\C-c/" 
  (lambda () "insert a javadoc comment"
    (interactive)
    (previous-line 1)
    (newline-and-indent)
    (insert "**/"); insert end first, so indentation aligns correctly
    (previous-line 1)
    (newline-and-indent)
    (insert "/**")
    (end-of-line)
    (newline-and-indent)))
(define-key java-mode-map "\C-cl" 
  (lambda (label)
    "insert {@link <label> <tt><label></tt>}"
    (interactive "*slabel: ")
    (insert "{@link " label " <tt>")
    (if (string-match "\\#\\([^(]+\\)" label)
	(insert (substring label (match-beginning 1) (match-end 1)))
      (insert label))
    (insert "</tt>}")))
(c-toggle-auto-state +1)

(defun c-right-justify-comment nil
  (interactive)
  (condition-case nil
      (save-excursion
	(end-of-line)
	(let ((eol (point)) bol start tocol)
	  (beginning-of-line)
	  (setq bol (point))
	  (re-search-forward "/\\*.*\\*/\\|//.*[^ \t\n]" eol)
	  (goto-char (match-beginning 0))
	  (setq start (current-column))
	  (goto-char (match-end 0))
	  (if (not (eq eol (match-end 0)))
					; Delete trailing white space (always)
	      (while (looking-at "[ \t]")
		(delete-char 1)))
	  (setq tocol (+ start (- (current-fill-column) (current-column))))
	  (move-to-column start)
	  (if (<= start tocol)
					; Need to add some space
	      (indent-to tocol)
					; Need to delete the space in between
	    (move-to-column start)	; This definitely is a non-tab
	    (while (> (current-column) tocol)
	      (backward-char 1)		; may back over a tab
	      (if (not (looking-at "[ \t]"))
	  (setq tocol (current-column))
		(delete-char 1)))
					; Woops deleted too much
	    (if (< (current-column) tocol)
		(indent-to tocol)))))
      (search-failed (indent-for-comment))))

(defvar c-align-field-column 32)
(defvar c-align-arg-column 56)
(defun c-align-decls (&optional align-col)
  "Align the declarations to the prefix argument column.  If no
prefix argument column, aligns to either c-align-field-column or
c-align-arg-column depending on whether the declarations are within
a function or struct/union.   If the mark is active, the alignment
occurs only within the region and uses c-align-field-column unless
there is a prefix argument."
  (interactive "*p")
  (let ((bol) (start) (end))
    (save-excursion
      ;; Comments like this "/*(x)*/" are broken
      (if mark-active
	  (progn
	    (setq start (region-beginning) end (region-end)) 
	    (if (= align-col 1)
		(setq align-col c-align-field-column)))
	(beginning-of-line)
	(if (not (re-search-forward "[)}]" (point-max) t)) ; end
	    (error "Not within function header, struct, or union"))
	(backward-char 1);; just before ) or }
	(setq end (point))
	(if (not (re-search-backward "[({]" (point-min) t)) ; start
	    (error "Not within function header, struct, or union"))
	(if (= align-col 1)
	    (setq align-col
		  (if (looking-at "(")
		      c-align-arg-column
		    c-align-field-column)))
	(forward-char);; just after ( or {
	(if (looking-at "[ \t]*$") 
	    (forward-line)
	  (insert "\n"))
	(setq start (point))
	(re-search-forward "[)}]" (point-max))
	(backward-char)
	(setq end (make-marker))
	(set-marker end (point))
	(beginning-of-line)
	(if (not (looking-at "[ \t]*[)}]"))
	    (progn
	      (goto-char (marker-position end))
	      (insert "\n"))))
      (goto-char end)
      (setq end (make-marker))
      (set-marker end (point))
      (goto-char start)
      (while (< (point) (marker-position end))
	(beginning-of-line)
	(if (looking-at "/\*")
	    (insert " "));; treats as strange comment-intro otherwise
	(c-indent-command)
	(setq bol (point))
	(end-of-line)
	(re-search-backward "=" bol t);; in case there's an initializer 
	(re-search-backward "[^ \t]" bol t)
	(if (re-search-backward "[ \t]" bol t)
	    (progn
	      (fixup-whitespace); delete all whitespace except one
	      (forward-char)
	      (if (looking-at "\*+")
		  (indent-to-column (- align-col 
				       (- (match-end 0) (match-beginning 0))))
		(indent-to-column align-col))))
	(forward-line))
      ;; indent "[)}]" line
      (c-indent-command))))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;; comint

(setq comint-password-prompt-regexp
      (concat "[pP]assphrase: \\|[pP]assword: \\|"
	      comint-password-prompt-regexp))
(add-hook 'comint-output-filter-functions
	  'comint-watch-for-password-prompt)

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;
;;;; Some Useful Functions
;;;;
(defun gosmacs-previous-window ()
  "Select the window above or to the left of the window now selected.
From the window at the upper left corner, select the one at the lower right."
  (interactive)
  (select-window (previous-window)))

(defun gosmacs-next-window ()
  "Select the window below or to the right of the window now selected.
From the window at the lower right corner, select the one at the upper left."
  (interactive)
  (select-window (next-window)))

(defun scroll-one-line-up (&optional arg)
  "Scroll the selected window up (forward in the text) one line (or N lines)."
  (interactive "p")
  (scroll-up (or arg 1)))

(defun scroll-one-line-down (&optional arg)
  "Scroll the selected window down (backward in the text) one line (or N)."
  (interactive "p")
  (scroll-down (or arg 1)))

(defun scroll-one-col-right (&optional arg)
  "Scroll the selected window right (text to the right) one column (or N cols)."
  (interactive "p")
  (scroll-right (or arg 1)))

(defun scroll-one-col-left (&optional arg)
  "Scroll the selected window left (text to the left) one column (or N cols)."
  (interactive "p")
  (scroll-left (or arg 1)))

(defvar shift-width 4
  "*The number of columns idented by shift-right or shift-left")

		   
(defun indent-by-shift (arg)
  "Change column by ARG shift-widths."
  (if (listp arg) (setq arg (car arg)))
  (if (= arg 0)
    nil
    (skip-chars-forward " \t")
    (if (> arg 0)
	; Shift always
      (indent-to-column (* (/ (+ (current-column) (* shift-width arg))
				shift-width) shift-width))
	; Negative shift first find spaces backwards
      (let ((opoint (point)))
	(beginning-of-line)
	(let ((pos (point)))
	  (goto-char opoint)
	  (if (re-search-backward "[ \t]*" pos t)
	      (progn
		(skip-chars-forward " \t")
		(backward-delete-char-untabify
		 (- (current-column)
		    (* (/ (max (- (+ (current-column)
				     (- shift-width 1))
				  (* shift-width 1)) ;arg
			       0) shift-width)
		       shift-width))))
	    ; failed to find spaces before point
	    (beginning-of-line)))))))
  
(defun shift-right (&optional arg)
  "Shift to the right by shift-width spaces."
  (interactive "p")
  (indent-by-shift (or arg 1)))

(defun shift-left (&optional arg)
  "Shift to the left by shift-width spaces."
  (interactive "p")
  (indent-by-shift (- (or arg 1))))

(defun join-line (&optional arg)
  (interactive "p")
  (let ((count (max (or arg 1) 1)))   ; Don't allow negative args
    (while (> count 0)
      (end-of-line)
      (delete-char 1)  ; If end of buffer, then will get a signal
      (fixup-whitespace)
      (setq count (- count 1)))))

(defun backward-upcase-word (&optional arg)
  (interactive "p")
  (upcase-word (- (or arg 1))))
(defun backward-downcase-word (&optional arg)
  (interactive "p")
  (downcase-word (- (or arg 1))))
(defun backward-capitalize-word (&optional arg)
  (interactive "p")
  (capitalize-word (- (or arg 1))))

(defun debug-mode ()
  "Toggles the current value of debug-on-error."
  (interactive)
  (setq debug-on-error (not debug-on-error))
  (message "debug-on-error is %s" debug-on-error))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;
;;;; HTML (html-mode)
;;;;

(defconst my-html-hook
  '(progn
    (define-key html-mode-map "\C-cp"
      (lambda (&optional arg) "inserts <pre> tag"
	(interactive "p") (sgml-tag "pre")))
    (define-key html-mode-map "\C-ct"
      (lambda (&optional arg) "inserts <table> tag"
	(interactive "p") (sgml-tag "table")))))
(if (and (boundp 'html-mode-map) (keymapp html-mode-map))
    (eval my-html-hook)
  (eval-after-load
      "html-mode"
    my-html-hook))

(autoload 'sqlplus "sql-mode" 
  "Run an interactive SQL*plus session in a separate buffer." t)
(setq sqlplus-mode-hook
      '(lambda ()
	 (turn-on-font-lock)
	 (define-key sqlplus-mode-map "\M-p" 'sqlplus-previous-command)
	 (define-key sqlplus-mode-map "\M-n" 'sqlplus-forward-command)))
(autoload 'sql-mode "sql-mode"
  "Major mode for editing SQL*plus batch files." t)
(setq sql-mode-hook
      '(lambda ()
	 (turn-on-font-lock)))
(autoload 'pls-mode  "pls-mode" "PL/SQL Editing Mode" t)
(autoload 'diana-mode  "pls-mode" "DIANA for PL/SQL Browsing Mode" t)
(if (boundp 'magic-mode-alist)
    (setq magic-mode-alist
	  (append '(("@h[1-4]" . text-mode))
		  magic-mode-alist)))
(setq auto-mode-alist
      (append '(("\\.pls$"  . pls-mode)
		("\\.sql$"  . pls-mode)
		; File begins with single letter followed by letters and
		; dashes is a cperl command.  All lower case.
		("/perl/.*/[a-z][a-z]?[a-z]?-[a-z0-9-]+$"  . cperl-mode)
		("\\.\\(bview\\|bconf\\|btest\\|bunit\\|t\\)$"  . cperl-mode)
                ("\\.\\([pP]\\([Llm]\\|erl\\)\\|al\\)\\'" . cperl-mode)
		("\\.pld$"  . diana-mode)
		)
	      auto-mode-alist))
(setq pls-mode-hook
      '(lambda ()
	 (turn-on-font-lock)
	 (define-key pls-mode-map "\C-c\C-m" 'sql-send-buffer)
	 (define-key pls-mode-map "\C-c\C-j" 'sql-send-region)))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;
;;;; Keys
;;;;

;;;; Ordinary keys
;;; Adds a new top menu to the menu bar
(define-key global-map "\177" 'backward-delete-char-untabify)

;;;; Control keys
(define-key text-mode-map "\C-i" 'shift-right)
(define-key global-map "\C-m" 'newline-and-indent)
(define-key global-map "\C-r" 'isearch-backward-regexp)
(define-key global-map "\C-s" 'isearch-forward-regexp)
(define-key global-map "\C-z" 'scroll-one-line-up)
(define-key global-map "\C-_" 'advertised-undo)

;;;; Meta keys
(define-key global-map "\M-c" 'backward-capitalize-word)
(define-key global-map "\M-h" 'backward-kill-word)
(define-key global-map "\M-i" 'shift-left)
(define-key global-map "\M-l" 'backward-downcase-word)
(define-key global-map "\M-p" 'mark-paragraph)
(define-key global-map "\M-u" 'backward-upcase-word)
(define-key global-map "\M-z" 'scroll-one-line-down)
(define-key global-map "\M-'" 'dabbrev-expand)
(define-key global-map "\M-C-'" 'dabbrev-completion)
(define-key global-map "\M-/" 'abbrev-prefix-mark)
(define-key global-map "\M-%" 'query-replace-regexp)

;;;; Control-x keys
(define-key ctl-x-map "l" 'goto-line)
(define-key ctl-x-map "n" 'gosmacs-next-window)
(define-key ctl-x-map "p" 'gosmacs-previous-window)

;;;; Control-x Control keys
(define-key ctl-x-map "\C-d" 'delete-window)
(define-key ctl-x-map "c" 'center-line)
(define-key ctl-x-map "\C-j" 'join-line)
(define-key ctl-x-map "\C-l" 'sort-lines)
(define-key ctl-x-map "\C-m" 'shell)
(define-key ctl-x-map "\C-n" 'insert-buffer)
(define-key ctl-x-map "\C-u" nil); DELETE
(define-key ctl-x-map "\C-z" 'shrink-window)

(put 'downcase-region 'disabled nil)