;;
;; $Id: startup.el,v 1.197 1999/02/24 19:14:19 ejb Exp $
;; $Source: /home/ejb/elisp/RCS/startup.el,v $
;; $Author: ejb $
;;
;; Emacs-lisp initialization
;;

(defvar suppress-font-lock nil "*suppress turn-on-font-lock lock when true")

(defun qstartup ()
  ;;
  ;; Put all initialization into a function for efficiency.  Note
  ;; that nested functions do not work in byte-compiled code.
  ;;
  
  ;; Figure out what version of emacs we're running
  (setq q::emacs-type
	(cond ((string-match "Lucid" emacs-version)
	       "lucid")
	      ((string-match "^18\\." emacs-version)
	       "gnu-18")
	      ((string-match "^19\\." emacs-version)
	       "gnu-19")
	      ((string-match "^20\\." emacs-version)
	       "gnu-20")
	      ((boundp 'epoch::version)
	       "epoch")
	      (t "unknown")))
  
  ;; Mode-line format
  ;; Now set in version-specific

  ;; Don't disable any commands.
  (put 'eval-expression 'disabled nil)
  (put 'narrow-to-region 'disabled nil)
  (put 'narrow-to-page 'disabled nil)
  (put 'downcase-region 'disabled nil)
  (put 'upcase-region 'disabled nil)
  (put 'set-goal-column 'disabled nil)

  (setq

   ;; General options
   inhibit-startup-message t
   default-major-mode 'text-mode
   initial-major-mode 'text-mode
   require-final-newline 1
   inhibit-default-init t
   blink-matching-paren-distance nil
   backup-by-copying-when-linked t
   backup-by-copying-when-mismatch t
   search-slow-speed 7200
   next-line-add-newlines t
   enable-local-variables t		; accept local variables
   enable-local-eval 0			; ask before taking local evals
   split-window-keep-point t
   find-file-existing-other-name t
   find-file-visit-truename nil
   diff-switches "-u2"
   message-log-max 200
   suggest-key-bindings nil
   auto-save-list-file-prefix "~/tmp/.saves-"
   highlight-wrong-size-font nil
   use-dialog-box nil
   search-highlight t
   query-replace-highlight t
   special-display-buffer-names
   '(
     "*Backtrace*"
     )
   
   ;; Options for standard packages
   dired-listing-switches "-alg"
   tags-add-tables t
   server-temp-file-regexp "/tmp/\\(Re\\|nn\\.\\)\\|/draft$"
   ediff-auto-refine-limit 50000
   vc-make-backup-files t
   vc-mistrust-permissions t
   desktop-missing-file-warning nil
   cperl-font-lock t
   font-lock-support-mode 'lazy-lock-mode
   lazy-lock-minimum-size '((c-mode . 1)
			    (c++-mode . 1)
			    (perl-mode . 1)
			    (cperl-mode . 1)
			    (sgml-mode . 1))

   ;; Uniquify variables must be set before uniquify is loaded
   uniquify-after-kill-buffer-p t
   uniquify-buffer-name-style 'post-forward

   mail-self-blind t			; BCC all mail to myself
   dabbrev-upcase-means-case-search t
   dabbrev-always-check-other-buffers t
   dabbrev-abbrev-char-regexp "\\sw\\|\\s_"
   mime-editor/split-message nil
  )
  
  (setq-default
   mode-line-buffer-identification '(" %b")
   mode-line-frame-identification (list (if window-system " " "-%F-"))
  )
  ;; remove ".log" from completion-ignored-extensions
  (let ((tmp completion-ignored-extensions) elem)
    (setq completion-ignored-extensions nil)
    (while tmp
      (setq elem (car tmp))
      (setq tmp (cdr tmp))
      (if (not (equal elem ".log"))
	  (setq completion-ignored-extensions
		(append completion-ignored-extensions (list elem))
	  )
      )
    )
  )

  (set-variable 'completion-ignored-extensions
		(append completion-ignored-extensions
			'(".bak" ".uid" ".dep" "CVS")))
  
  ;; Where to find elisp files
  (set-variable 'load-path
		(append (list
			 (expand-file-name "~/elisp")
			 (expand-file-name "~/elisp/q")  
			 (expand-file-name "~/elisp/pkg")  
			 (concat (expand-file-name "~/elisp/") q::emacs-type)
			)
			load-path))

  ;; Automatic mode selection
  (require 'jka-compr)
  (set-variable 'auto-mode-alist
		(append '(
			  ("\\.cgi\\'" . perl-mode)
			  ("\\.ent\\'" . sgml-mode)
			  ("\\.ft\\'" . family-tree-mode)
			  ("\\.gwm\\'" . lisp-mode)
			  ("\\.mki\\'" . makefile-mode)
			  ("\\.rpmspec\\'" . sgml-mode)
			  ("\\.relspec\\'" . sgml-mode)
			  ("\\.tdf\\'" . sgml-mode)
			  ("\\.uil\\'" . uil-mode)

			  ("\\.equ\\'" . clu-mode)
			  ("\\.spc\\'" . clu-mode)

			  ("\\.icc\\'" . c++-mode)
			  ("\\.idl\\'" . c++-mode)

			  ("\\.x\\'" . c-mode)

			  ("\\.i3\\'" . modula-3-mode)
			  ("\\.m3\\'" . modula-3-mode)
			  ("\\.ig\\'" . modula-3-mode)
			  ("\\.mg\\'" . modula-3-mode)
			)
			auto-mode-alist))

  ;; Hooks
  (add-hook 'find-file-hooks 'project-check)
  (add-hook 'find-file-hooks 'symlink-check)
  (add-hook 'TeX-mode-hook
	    (function
	     (lambda ()
	       (if (not suppress-font-lock)
		   (turn-on-font-lock)
	       )
	       (make-local-variable 'require-final-newline)
	       (setq require-final-newline t)))
  )
	
  (setq tex-mode-hook TeX-mode-hook)

  (add-hook 'sgml-mode-hook
	    (function
	     (lambda()
	       (define-key sgml-mode-map "\C-?" 'backward-delete-char-untabify)
	       (define-key sgml-mode-map "\C-c\C-c" 'fix-sgml-comment-block)
	       (if (not suppress-font-lock)
		   (turn-on-font-lock)
	       )
	       (make-local-variable 'indent-tabs-mode)
	       (setq indent-tabs-mode nil)
	     )
	    )
  )

  (add-hook 'text-mode-hook
	    (function
	     (lambda () 
	       (auto-fill-mode 1) 
	       (local-set-key "\C-?" 'backward-delete-char-untabify)
	       (setq indent-line-function 'indent-relative-maybe)
	     )
	    )
  )
  
  (add-hook 'rmail-mode-hook
	    (function
	     (lambda ()
	       (require 'paranoid-backup)
	       (paranoid-backup-mode t)
	       (local-set-key "\C-c\C-t" 'remove-ms-tnef)
	       (local-set-key "\C-c\C-m" 'clean-mime)
	       (if (not suppress-font-lock)
		   (turn-on-font-lock)
	       )
	     )
	    )
  )

  (add-hook 'mail-mode-hook
	    (function
	     (lambda () 
	       (if (not suppress-font-lock)
		   (turn-on-font-lock)
	       )
	       (if (fboundp 'flyspell-mode)
		   (flyspell-mode 1)
	       )
	       (local-set-key "\C-c\C-c" (make-sparse-keymap))
	       (local-set-key "\C-c\C-cs" 'mail-send-and-exit)
	       (local-set-key "\C-c\C-s" (make-sparse-keymap))
	       (local-set-key "\C-c\C-ss" 'mail-send)
	       (local-set-key "\C-c\C-f\C-p" 'q-mail-alternative)
	       (local-set-key "\C-c\C-f\C-a" 'q-mail-alternative)
	       (local-set-key "\C-c\C-w" 'q-insert-signature)
	     )
	    )
  )
	   
  (add-hook 'mail-setup-hook ; invoked in buffer with existing default headers
	    (function
	     (lambda ()
	       (save-excursion
		 (goto-char (point-min))
		 (and (re-search-forward "^BCC: " nil t)
		      (looking-at "\\([a-z]+\\)@.*")
		      (replace-match "\\1"))
	       )
	       (q-fix-from-address)
	       (if cc (query-delete-cc))	; verify before including CC
	       (auto-fill-mode 1) 

	       (substitute-key-definition
		'next-line 'mail-abbrev-next-line
		mail-mode-map global-map
	       )
	       (substitute-key-definition
		'end-of-buffer 'mail-abbrev-end-of-buffer
		mail-mode-map global-map
	       )
	       (q-query-from-address)
	     )
	    )
  )
  (add-hook 'mail-setup-hook 'mail-abbrevs-setup)
  (add-hook 'mail-send-hook
	    (function
	     (lambda ()
	       (if (fboundp 'flyspell-mode)
		   (flyspell-mode nil)
	       )
	     )
	    )
  )

  (add-hook 'c-mode-common-hook
	    (function
	     (lambda ()
	       (c-set-style "Q")
	       (make-local-variable 'dabbrev-case-fold-search)
	       (make-local-variable 'dabbrev-case-replace)
	       (setq dabbrev-case-fold-search nil
		     dabbrev-case-replace nil)
	       (make-local-variable 'font-lock-maximum-decoration)
	       (setq font-lock-maximum-decoration t)
	       (if (not suppress-font-lock)
		   (turn-on-font-lock)
	       )
	       (local-set-key "\C-z\C-p" 'c-ansidecl-to-proto)
	     )
	    )
  )

  (add-hook 'c-mode-hook
	    (function
	     (lambda ()
	       (local-set-key "\C-z\C-i" 'c-make-dual-fn-decl)
	       (local-set-key "\C-z\C-a" 'c-make-ansi-decl)
	     )
	    )
  )
  
  (add-hook 'c++-mode-hook
	    (function
	     (lambda ()
	       (local-set-key "\C-c\C-n" 'c-forward-conditional)
	       (local-set-key "\C-c\C-p" 'c-backward-conditional)
	     )
	    )
  )

  (add-hook 'clu-mode-hook
	    (function
	     (lambda ()
	       (make-local-variable 'require-final-newline)
	       (setq require-final-newline t)
	     )
	    )
  )

  (add-hook 'uil-mode-hook
	    (function
	     (lambda ()
	       (require 'quil)
	       (setq
		uil-indent-level 3
		uil-justified-comment-pattern "!!"
		uil-auto-insert-semicolon nil)
	     )
	    )
  )

  (add-hook 'perl-mode-hook
	    (function
	     (lambda ()
	       (setq
		perl-tab-always-indent t
		perl-tab-to-comment nil)
	       (local-set-key "\C-z\C-a" 'q-perl-accessor)
	       (if (not suppress-font-lock)
		   (turn-on-font-lock)
	       )
	     )
	    )
  )

  (add-hook 'cperl-mode-hook
	    (function
	     (lambda ()
	       (cperl-set-style "C++")
	       (local-set-key "\C-z\C-a" 'q-perl-accessor)
;	       (if (not suppress-font-lock)
;		   (turn-on-font-lock)
;	       )
	     )
	    )
  )

  (add-hook 'makefile-mode-hook
	    (function
	     (lambda ()
	       (local-set-key "\C-zm" 'make-maketarget)
	       (if (not suppress-font-lock)
		   (turn-on-font-lock)
	       )
	     )
	    )
  )

  (add-hook 'lisp-mode-hook
	    (function
	     (lambda ()
	       (require 'fg-lisp-indent)
	       (setq require-final-newline t)
	     )
	    )
  )

  (add-hook 'emacs-lisp-mode-hook
	    (function
	     (lambda ()
	       (if (not suppress-font-lock)
		   (turn-on-font-lock)
	       )
	       (require 'fg-lisp-indent)
	       (setq require-final-newline t)
	     )
	    )
  )
  
  (add-hook 'Info-mode-hook 'info-fix-face-fonts)

  (add-hook 'm3::mode-hook
	    (function
	     (lambda ()
	       (if (not suppress-font-lock)
		   (progn
		     (require 'load-m3font)
		     (turn-on-font-lock)
		     (m3-font-lock-hack)
		   )
	       )
	     )
	    )
  )

  ;; Autoload
  (autoload 'perl-mode "perl-mode" "Major mode for Perl" t)
  (autoload 'discuss "discuss.elc" "Start discuss " t)
  (autoload 'c-make-dual-fn-decl "ansidecl" 
    "Make dual function declaration out of ansi declaration" t)
  (autoload 'c-make-ansi-decl "ansidecl" 
    "Make ansi function declaration out of old-style declaration" t)
  (autoload 'c-ansidecl-to-proto "ansidecl" 
    "Make ansi function prototype out of declaration" t)
  (autoload 'desktop-save "desktop" "Save buffer configuration" t)
  (autoload 'desktop-read "desktop" "Save buffer configuration" t)
  (autoload 'family-tree-mode "family-tree" "Family tree editing mode" t)
  (autoload 'uil-mode "uil-mode" "Major mode for editing uil files" t)
  (autoload 'find-weekly-report-file "apex-weekly-report"
    "apex weekly reports" t)
  (autoload 'food "qfood" "food tracking support" t)
  (autoload 'modula-3-mode "modula3" "Modula 3 mode" t)

  (if (not (fboundp 'pop-tag-mark))
      (progn
	(autoload 'q-find-tag "qtags" "Find-tag that saves return point" t)
	(autoload 'q-find-tag-regexp "qtags"
	  "Find-tag-regexp that saves return point" t)
	(global-set-key "\M-." 'q-find-tag)
	(global-set-key "\M-*" 'q-pop-tag-mark)
	(define-key esc-map [?\C-.] 'q-find-tag-regexp)
      )
  )

  ;; Load file containing short functions
  (load "qfuncs")
  (qfuncs-init)

  ;; Mail abbreviations
  (load "mail-abbrevs")

  ;; ange-ftp gets loaded the first time you do file completion from /, so
  ;; may as well load it up now.
  (require 'ange-ftp)

  (require 'compile)
  (setq
   compilation-error-regexp-alist 
   (append '(
	     ("^[WE], \\([^(]+\\)(\\([0-9]+\\),\\s-*[0-9]+)" 1 2)
	   )
	   compilation-error-regexp-alist)
  )

  (require 'uniquify)

  ;; key bindings
  ;; Use ctrl-z as my private prefix character.  Rebind whatever Ctrl-z
  ;; was to ctrl-z ctrl-z
  ;;
  (let ((kb 
	 (cond (
		(or (equal q::emacs-type "gnu-18")
		    (equal q::emacs-type "lucid")
		)
		(key-binding "\C-z")
	       )
	       (t (key-binding "\C-z" t))
	 )
	)
       )
    (global-set-key "\C-z" (make-sparse-keymap))
    (if kb
	(global-set-key "\C-z\C-z" kb)
    )
  )
  
  (global-set-key "\C-x\C-g" 'goto-line)
  (global-set-key "\C-x\C-l" 'q-recenter)
  (global-set-key "\C-x\C-z" 'q-pop-mark)
  (global-set-key "\M-?" 'what-line)
  (global-set-key "\M-\C-z" 'kill-to-eob)
  (global-set-key "\C-\\" 'call-last-kbd-macro)
  (global-set-key " " 'q-space)
  (global-set-key [C-M-SPC] 'overwrite-space)

  (global-set-key "\C-zr" 'revert-some-buffers)
  (global-set-key "\C-z=" 'underline-with-char)
  (global-set-key "\C-z." 'dots)
  (global-set-key "\C-zc" 'compile)
  (global-set-key "\C-z\C-c" 'make-this-file)
  (global-set-key "\C-z\C-d" 'font-lock-fontify-buffer)
  (global-set-key "\C-z\C-f" 'find-file-at-point)
  (global-set-key "\C-z\C-g" 'kill-compilation)
  (global-set-key "\C-z\C-i" 'insert-space)
  (global-set-key "\C-z\C-m" 'make)
  (global-set-key "\C-z\C-n" 'normal-mode)
  (global-set-key "\C-z\C-r" 'revert-buffer)
  (global-set-key "\C-z\C-s" 'desktop-save)
  (global-set-key "\C-z\C-w" 'q-insert-signature)
  
  ;; no more accidental exits
  (global-set-key "\C-x\C-c" (make-sparse-keymap))
  (global-set-key "\C-x\C-cq" 'save-buffers-kill-emacs)

  (global-set-key [C-tab] 'mimic-tab)
  (global-set-key [S-tab] 'mimic-tab)
  (global-set-key [C-delete] 'advertised-undo)
  (global-set-key [C-backspace] 'advertised-undo)
  (global-set-key [S-delete] 'mimic-del)
  (global-set-key [S-backspace] 'mimic-del)
  (global-set-key [insert] 'noop)
  (global-set-key (vector (event-convert-list '(control ?`))) 'next-error)
  (global-set-key "\C-x\C-q" 'toggle-read-only)
  (global-set-key "\C-z\C-o" 'vc-toggle-read-only)
  (global-set-key "\C-x52" 'q-new-frame)
  (global-unset-key "\C-x\C-u")		; I hate it when I upper-case
					; everything while undoing!
  
  ;; Disable mouse-1 functions since they cause problems with laptops
  ;; with touch pads and I don't use the mouse with emacs anyway.
  (define-key global-map [mouse-1] 'noop)
  (define-key global-map [down-mouse-1] 'noop)
  (define-key global-map [drag-mouse-1] 'noop)
  (define-key global-map [double-mouse-1] 'noop)

  (define-key global-map [C-mouse-1] 'noop)
  (define-key global-map [C-down-mouse-1] 'noop)
  (define-key global-map [C-drag-mouse-1] 'noop)
  (define-key global-map [C-double-mouse-1] 'noop)

  (define-key global-map [S-mouse-1] 'noop)
  (define-key global-map [S-down-mouse-1] 'noop)
  (define-key global-map [S-drag-mouse-1] 'noop)
  (define-key global-map [S-double-mouse-1] 'noop)


  ;; This binding only if windowmanager is not capable of warping pointer
  (let (trash-wm)
    (if (getenv "WM")
	(if (not (or
		  (equal (getenv "WM") "gwm")
		  (equal (getenv "WM") "mwm")
		  (equal (getenv "WM") "twm")))
	    (setq trash-wm t)))
    (if trash-wm
	(global-set-key "\C-x\C-k" 'warp-to-qxterm)))

  ;; Work around /usr/lib/sendmail bug if necessary
  (if (getenv "EMACS_SENDMAIL_HACK")
      (setq sendmail-program (concat (getenv "HOME") "/scripts/fake-sendmail"))
  )

  (if (not (eq system-type 'ms-dos))
      (progn
	;; Q signature
	(load "q-signature")
	(q-parse-signature-file)
	
	;; time and server require asynchronous subprocesses which DOS
	;; can't handle

	;; Time
	(display-time)
	
	(if (not (eq system-type 'windows-nt))
	    ;; Server
	    (server-start nil)
	)
      )
  )

  (if (fboundp 'line-number-mode)
      (line-number-mode 1)
  )
  (if (fboundp 'column-number-mode)
      (column-number-mode 1)
  )
  (if (fboundp 'menu-bar-mode)
      (menu-bar-mode -1)
  )
  (if (fboundp 'scroll-bar-mode)
      (scroll-bar-mode -1)
  )
  (if (fboundp 'resize-minibuffer-mode)
      (resize-minibuffer-mode 1)
  )
  (fix-frame-parameters)
  (work-around-vc-brain-damage)

  ;; Move global-mode-string to the end of the mode line and elminiate
  ;; excess whitespace before it
  (let ((tmp1 (default-value 'mode-line-format))
	(tmp2 nil)
	(cur-item nil)
       )
    (while (not (null tmp1))
      (setq cur-item (car tmp1)
	    tmp1 (cdr tmp1)
      )
      (cond ((equal cur-item 'global-mode-string)
	     nil
	    )
	    ((equal cur-item "-%-")
	     (setq tmp2 (append tmp2 (list " " 'global-mode-string " -%-")))
	    )
	    ((and (stringp cur-item)
		  (string-match "^ +$" cur-item)
		  (equal (car tmp1) 'global-mode-string)
	     )
	     nil
	    )
	    (t
	     (setq tmp2 (append tmp2 (list cur-item)))
	    )
      )
    )
    (setq-default mode-line-format tmp2)
  )

  ;; Load mime setup if available
  (condition-case nil
      (load "mime-setup")
    (error nil)
  )

  ;; Load support for project-specific minor mode
  (load "project")

  ;; Version specific initialization
  (load "version-specific")
  (q-vs-init)

  (load "site-specific")
  (q-site-init)

  (if (eq system-type 'windows-nt)
      (load "win32-setup")
  )

)					; end startup