;;; GNU Emacs init file for Henry Thompson
;;; This part shared between all hosts
;;; This part sharable by anyone
;;; initialisation file for Emacs, that is, emacs, lemacs and epoch common
;;; Last edited: Sat Jun 26 10:44:46 1993
;;; Edit history since port:  made load-path not site-dependant
;;; split into common-init for all my incarnations and pers-init for private
;;; added -debug switch
;;; added lemacs
;;; minor accomodations to changes in epoch and rmht-output
;;; added emacs19

(setq load-path (cons "c:/C64/usr/local/share/xemacs/xemacs-packages/lisp"
		      load-path))

(setq command-switch-alist
      (append command-switch-alist '(("-debug" . identity))))

(mapcar
 (function
  (lambda (s)
    (if (equal "-debug" s)
    (progn (load "debug" nil t)
	   (setq debug-on-error t)))))
 command-line-args)

;;; switch for embedding site-specific stuff
;;; site-name is global bound in .emacs itself
(defmacro site-caseq (&rest cases)
  "simplified cond to switch on site-name"
  (let ((clauses (cons 'cond nil)))
    (while cases
      (nconc clauses
	     (cons
	      (cons 
	       (if (eq (car (car cases)) t)
		   t
		 (if (consp (car (car cases)))
		     (list 'memq 'site-name (list 'quote (car (car cases))))
		   (list 'eq 'site-name (list 'quote (car (car cases))))))
	       (cdr (car cases)))
	      nil))
      (setq cases (cdr cases)))
    clauses))


;;; variables and the like

(put 'eval-expression 'disabled nil)	;enable minibuffer
(put 'narrow-to-region 'disabled nil)	; and this one too
(setq inhibit-startup-message t)	;shhh!
(when (eq (device-type) 'tty)
  (setq frame-background-mode 'light))  ; override stupid default for TTY in 
(setq default-custom-frame-properties nil) ;force recomputation
(initialize-custom-faces)
(setq gnuserv-frame-plist '(background-mode light))
(setq require-final-newline 'ask)
(setq next-line-add-newlines t)
(setq enable-recursive-minibuffers t)	;allow extended commands
(setq minibuffer-max-depth nil)
(setq rmht-allow-autosave nil)

;;; adaptive fill takes account of para numbering
(setq adaptive-fill-regexp nil)
(add-hook 'message-mode-hook
	  (lambda () (setq adaptive-fill-regexp nil)))
(setq adaptive-fill-function
  (lambda ()
    (if (and (listp buffer-undo-list)
             (numberp (car buffer-undo-list))
             (> (- (car buffer-undo-list) (point)) 1) ; avoid spurious 'prefix'
	     (looking-at "\\([ \t]*\\)\\([0-9a-z.]+[).] +\\|* +\\)"))
	(concat (buffer-substring-no-properties start (match-end 1))
		(format "%*s" (- (match-end 2)(match-beginning 2)) ""))
      (if (looking-at "[ \t]*\\([#;>*]+ +\\)?")
	  (buffer-substring-no-properties start (match-end 0))))))

(setq fill-indent-according-to-mode t)
;; Used in auctext/latex.el:LaTeX-fill-region-as-para-do,
;;  which emacs defines in textmodes/fill.el, but xemacs does not?

(add-hook 'text-mode-hook (function (lambda () (setq adaptive-fill-mode t))))

(site-caseq (parc
	     (setq default-major-mode 'text-mode)
	     (setq version-control t)	;gimme numbers
	     (setq trim-versions-without-asking t) ; but trim quietly
	     ))

(setq meta-flag (not (string-equal (getenv "ORIG_TERM")
				   "dialup")))		;check that bit!

(site-caseq (edin (setq lpr-switches '("-Plw4"))	; print locally
		  (setq lpr-command "/home/ht/bin/mpr")) ; two-up
	    (ircs (setq lpr-switches '("-h"))))

(setq load-path (append
		 (site-caseq (edin
			      (list "/export/contrib/src/master/edb"
				    (expand-file-name "~ht/emacs/local")
				    (expand-file-name "~ht/emacs/shared")))
			     ((laptop maritain)
			      (list (expand-file-name "~/lib/emacs/")
				    ;;(expand-file-name "/usr/local/LSL/emacs")
				    ))
			     (t (list (expand-file-name "~/emacs/local")
				      (expand-file-name "~/emacs/shared"))))
		 load-path))



(site-caseq (edin (load "auto-insert-tkld" nil t)
		  (setq auto-insert-path
			'("~ht/insert/"
			  "~tkld/lib/insert/"
			  "/usr/local/share/lib/insert/"))))

(defun make-auto-save-file-name nil	;the default is awful
  (concat buffer-file-name ".sav"))

(defun home ()
  (interactive)
  (cd "~/"))

(defun Debug-on-error (&optional state)
  "toggle debug-on-error, loading if necessary"
  (interactive)
  (if (not (boundp 'debugger-mode-map))
      (load "debug" nil t))
  (setq debug-on-error
	(cond ((eq state 'off)
	       nil)
	      (state t)
	      (t (not debug-on-error))))
  (message "Error debugging %s" (if debug-on-error "on" "off")))


(setq command-switch-alist
      (nconc command-switch-alist '(("-r" . ht-rooms-setup)
				    ("-slow" . hack-xon)
				    ("-rooms" . ht-rooms-setup))))
; from miles
; Tweak the completion handling. Still not quite like I want it but...
(define-key minibuffer-local-completion-map " " 'minibuffer-complete)
(define-key minibuffer-local-must-match-map " " 'minibuffer-complete)

(site-caseq (parc (load "marg-and-comm" nil t))) ; where is this functionality
					; in Edinburgh?

(defun hack-xon (&optional switch)
  "call this to hack a life when flow-control in operation"
  (interactive)
  (set-input-mode nil t)
  (global-set-key "\C-^" 'isearch-forward)
  (global-set-key "\C-\M-^" 'isearch-forward-regexp)
  (setq search-repeat-char (string-to-char "\C-^"))
  (global-set-key "\C-x\C-^" 'save-buffer)
  (global-set-key "\C-\\" 'quoted-insert)
  (global-set-key "\C-\M-\\" 'indent-sexp))

(site-caseq (parc (load "lisp-hacks")))  ; what does this do, anyway?

(global-set-key "\C-\M-_" 'backward-kill-sexp)
(global-set-key "\M-r" 'replace-string)

(setq auto-mode-alist
      (nconc auto-mode-alist '(("\\.gwm$" . lisp-mode))))

(autoload 'lsl-mode "lsl-mode" "Larch (LSL) mode" t)
(autoload 'sgml-mode "psgml" "SGML mode" t)
(autoload 'python-mode "python-mode" "Python code editing mode" t)
(setq py-indent-offset 2)

(setq auto-mode-alist 
      (nconc
       auto-mode-alist
       (list (cons "\\.py$" 'python-mode)
	     (cons "\\.sgm$" 'sgml-mode)
	     (cons "\\.oxl$"  'sgml-mode)
	     (cons "\\.oxs$"  'sgml-mode)
	     (cons "\\.ent$"  'sgml-mode)
	     (cons "\\.dtd$"  'xml-mode)
	     (cons "\\.xml$" 'xml-mode)
	     (cons "\\.xsl$" 'xml-mode)
	     (cons "\\.xsd$" 'xml-mode)
	     (cons "\\.xpdl$" 'xml-mode)
	     (cons "\\.pd$" 'xml-mode)
	     (cons "\\.dsl$" 'scheme-mode)
	     (cons "\\.lsl$" 'lsl-mode))))

(setq auto-mode-alist
      (cons '("\\.tex\\'" . latex-mode)
	    auto-mode-alist))
(setq tex-start-of-header "\\document")
;;; stupid (la)tex-mode has \documentstyle welded in!!!
(add-hook 'latex-mode-hook (function
			    (lambda ()
			      (setq tex-start-of-header "\\document"))))
(setq tex-dvi-view-command "viewdvi")

(defun my-edb-hook ()
  (if (string-match
       "\\.db$"
       buffer-file-name)
      (progn
	(db-this-buffer)
	(split-window-vertically nil))))
(autoload 'db-this-buffer "database" "load database and makes the buffer a db")

(site-caseq (parc (load "version-hacks" t)))


;;; which one will we get

(defun whereis (file &optional suffixes)
  "search load-path for FILE as load-library would.  Use SUFFIXES if provided"
  (interactive "sPackage name: ")
  (let ((suffixes (or suffixes '("elc" "el" ""))))
    (catch 'win
      (while suffixes
	(let((name (concat file "." (car suffixes)))
	     (path load-path))
	  (while path
	    (let ((full (concat (file-name-as-directory(car path)) name)))
	      (if (file-exists-p full)
		  (progn (if (interactive-p)
			     (message "%s" full))
			 (throw 'win full))))
	    (setq path (cdr path))))
	(setq suffixes (cdr suffixes))))))

(defun find-library (file) "Edit the definition of the library FILE"
  (interactive "sPackage name: ")
  (let ((home (whereis file))
	(sym-home (whereis file '("el"))))
    (if (not sym-home)
	(error "No .el file found for %s" file)
      (if (not (equal (file-name-directory home)
		      (file-name-directory sym-home)))
	  (progn (message "Warning: %s <> %s" home sym-home)
		 (sit-for 2)))
      (if (equal home sym-home)
	  (progn
	    (message "Warning: no compiled version found for %s" file)
	    (sit-for 2)))
      (find-file sym-home)
      (message sym-home))))

(if (boundp 'epoch::version)
    ;; epoch only goes here
    (progn
      (define-key minibuffer-local-ns-map " " 'minibuffer-complete)
      (setq my-epoch-font
	    (site-caseq (parc "-adobe-courier-medium-r-normal--12-*")
			(edin "-adobe-courier-medium-r-normal--14-*")))

      (font my-epoch-font)
      (font my-epoch-font (minibuf-screen))

      (setq epoch::screen-properties
	    (cons
	     (cons 'font my-epoch-font)
	     epoch::screen-properties))

      (site-caseq (parc (move-screen 584 879 (minibuf-screen)))
		  (edin (move-screen 415 877 (minibuf-screen))))

      (setq include-system-name t)

      (setq auto-raise-screen nil)

      (epoch::title (concat "Minibuffer:" (user-login-name) "@" (system-name))
		    (minibuf-screen))

      (defun shrink-me () "shrink current screen and minibuf if alive"
	(interactive)
	(on-map-do (current-screen) 'check-mini)
	(iconify-screen)  
	(if (screen-mapped-p (minibuf-screen))
	    (iconify-screen (minibuf-screen))))

      (defun check-mini (&optional screen) "map minibuf if not mapped"
	(if (not (screen-mapped-p (minibuf-screen)))
	    (map-screen (minibuf-screen))))

      (global-set-key "\C-ci" 'shrink-me)
      (require 'vc)
      ))
(if (> emacs-major-version 18)
    ;; common v19
    (progn
      (defun hack-xon (&optional switch)
	"call this to hack a life when flow-control in operation"
	(interactive)
	(set-input-mode nil t nil)
	(global-set-key "\C-^" 'isearch-forward)
	(global-set-key "\C-\M-^" 'isearch-forward-regexp)
        (define-key isearch-mode-map "\C-^" 'isearch-repeat-forward)
	(global-set-key "\C-x\C-^" 'save-buffer)
	(global-set-key "\C-\\" 'quoted-insert)
	(global-set-key "\C-\M-\\" 'indent-sexp))

      (add-hook 'find-file-hooks 'my-edb-hook t)

      (if (boundp 'Info-default-directory-list)
	  (setq Info-default-directory-list
		;; less than satisfactory, as searches them all . . .
		(append
		 Info-default-directory-list
		 (site-caseq (edin 
			      '("/usr/local/share/lib/info"
				"/usr/contrib/share/lib/info/"
				"/usr/contrib/share/info/"))
			     (ldc  '("/home/ht/ldc2/info/"))
			     (ircs '("/pkg/gnu-emacs-18.58/info")))))
	(setq Info-directory-list
		(append
		 Info-directory-list
		 (site-caseq (edin 
			      '("/usr/local/share/lib/info"
				"/usr/contrib/share/lib/info/"
				"/usr/contrib/share/info/"))
			     (ldc  '("/home/ht/ldc2/info/"))
			     (ircs '("/pkg/gnu-emacs-18.58/info"))))))
      (package-ui-add-site (quote ("sunsite.doc.ic.ac.uk" "packages/xemacs/packages")))
      (if window-system
	  (progn
	    (load "font-lock" nil t)
	    (setq font-lock-maximum-size nil)
	    (site-caseq (laptop (set-frame-height nil 40)
				(global-set-key
				 [(meta delete)] 'backward-kill-word)
				(global-set-key
				 [delete]
				 'backward-delete-char-untabify))
			(t (setq load-path
				 (cons (expand-file-name
					"~ht/emacs/v19/font-lock")
				       load-path))))
	    (if (string-match "Lucid" emacs-version)
		(progn
;;		  (setq load-path
;;		      (cons (expand-file-name
	;;		     "~rjc/lib/emacs-cogsci/rjc-lisp/font-lock")
		;;	    load-path))
		  (setq screen-title-format
			(setq screen-icon-title-format
			      (concat (getenv "LOCALHOST")
				      " Xemacs %S")))
		  (defvar yank-menu-length 40
		    "*Maximum length of an item in the menu for select-and-yank.")
		  (defun select-and-yank-filter (menu)
		    (let* ((count 0))
		      (append menu
			      (mapcar
			       #'(lambda (str)
				   (if (> (length str) yank-menu-length)
				       (setq str (substring str 0 yank-menu-length)))
				   (prog1
				       (vector
					str
					(list
					 'progn
					 '(push-mark (point))
					 (list 'insert (list 'current-kill count t)))
					t)
				     (setq count (1+ count))))
			       kill-ring))))
		  (add-submenu '("Edit")
			       '("Select and Yank"
				 :included kill-ring
				 :filter select-and-yank-filter))
		  ;; no toolbars, please!
		  (if (or (> emacs-major-version 19)(> emacs-minor-version 12))
		      (progn (add-spec-to-specifier top-toolbar-height 0)
			     (set-specifier modeline-shadow-thickness 0)
			     ;; (load "font-lock-mods-new" nil t)
			     )
		    ;; (load "font-lock-mods" nil t)
		    ))
	      (load "font-lock-mods" nil t)
	      (load "dsssl-mode" nil t)
	      )

	    ; (setq font-lock-string-face 'italic)
	    ))

      (if (string-match "Lucid" emacs-version)
	  ;; lemacs only goes here
	  (progn (setq bar-cursor 2)
		 ;; (set-face-underline-p 'font-lock-string-face nil)
		 (setq c-basic-offset 2) ; for cc-mode
		 (setq mail-default-headers nil)
		 (site-caseq (edin	; firewall pblms [no more?]
			      (setq efs-use-passive-mode nil)))
		 (define-key read-file-name-map "~" 'minibuffer-electric-tilde)
		 (define-key read-file-name-must-match-map "~" 'minibuffer-electric-tilde)

		 (load "man" nil t)
		 ;; fix a bug in compilation of interactive-p???
					;	     (define-key minibuffer-local-map " " 'minibuffer-complete)
		 ;; fix a bug in minibuf.el
		 (setq last-exact-completion nil)
					;	     (set-face-font 'default "-adobe-courier-medium-r-normal--14-*")
		 (site-caseq (laptop (require 'pcl-cvs)
				     (setq cvs-program "/usr/bin/cvs")
				     (setq vc-path '("/usr/bin"))
				     (require 'vc))
			     (t (require 'vc)))
					;	     (sit-for 2)
		 ;; this shouldn't be needed
					;	     (set-screen-size (selected-screen) 81 50)
					;	     (sit-for 2)

		 )
	;; vanilla v19 here
	(setq
	 load-path
	 (mapcar
	  (function
	   (lambda (d)
	     (file-name-as-directory d)))
	  (append (append
		   (site-caseq (edin (list
				      (expand-file-name "~ht/emacs/v19")
				      "/export/contrib/src/master/edb/v19"))
			       (laptop nil)
			       (t (list (expand-file-name "~/emacs/v19"))))
		   load-path)
		  ;; old emacs as fallback
		  (site-caseq
		   (edin
		    '("/usr/local/share/lib/emacslocal/lisp"
		      "/usr/local/share/lib/emacs/lisp"
		      "/usr/contrib/share/lib/emacs/lisp"))
		   (ircs
		    '("/pkg/gnu-emacs-18.58/lisp"))))))

	(defun remove-hook (hook-name function)
	  (set hook-name
	       (apply (function nconc)
		(mapcar (function
			 (lambda (f)
			   (if (eq f function)
			       nil
			     (list f))))
			(eval hook-name)))))
	(load "man" nil t)
	))
  ;; emacs 18 only goes here
    (define-key minibuffer-local-ns-map " " 'minibuffer-complete)
    (require 'vc))

(require 'misc)			; define M-e, M-m, C-X-., etc.
(require 'rooms)
(global-set-key "\M-o" (function other-frame))
(require 'recent-files)
(setq recent-files-non-permanent-submenu t)
(recent-files-initialize)
;(add-to-list 'load-path (expand-file-name "/usr/local/jdee/lisp") t)
(add-to-list 'load-path
	     (expand-file-name "~/.xemacs/site-lisp/jdee-2.4.0.1/lisp") t)
;(setq semantic-load-turn-useful-things-on t)
;stale(load-file "~/.xemacs/site-lisp/cedet-1.0pre4/common/cedet.elc")
;(load-file "~/.xemacs/site-lisp/cedet-cvs/cedet/common/cedet.elc")
;(load-file "/home/ht/.xemacs/site-lisp/cedet-bzr/trunk/cedet-devel-load.el")
;(add-to-list 'load-path (expand-file-name "~/.xemacs/site-lisp/ecb") t)
;;; Try to keep ecb from hanging. . .
(setq
 ecb-prescan-directories-for-emptyness 'unless-remote
 ecb-vc-enable-support t ;; 'unless-remote		; super-slow
 ecb-ping-options '("HOST" "56" "1")		; for cygwin
 ecb-vc-xemacs-exclude-remote-cvs-repository nil  ; override - we _do_ have vc-cvs-stay-local
 )
;(require 'jde-autoload)
;(require 'ecb-autoloads)
(defun jmh-hack ()
  (jde-usages-load-ecb-integration)
  (remove-hook 'jde-mode-hook (function jmh-hack)))
;;;(add-hook  'jde-mode-hook (function jmh-hack))
(defun jrmh-hack ()
  (define-key (current-local-map) [(shift mouse-2)]
    'jde-run-etrace-show-at-mouse)
  (remove-hook 'jde-run-mode-hook (function jrmh-hack)))
(add-hook 'jde-run-mode-hook
    (function jrmh-hack))


(if (getenv "FLOW_CONTROL")
    (hack-xon))
(setq ediff-diff-options "--binary "
      ediff-cmp-program "diff"
      ediff-cmp-options
      '("--ignore-matching-lines=\\$AutoGeneratedBy:" "--ignore-matching-lines=^<!-- Created" "--ignore-matching-lines=^date:" "--ignore-matching-lines=^\\w+, [0-9]+ \\w+ [0-9]+ [0-9]+:[0-9]+:[0-9]+" "--brief" "--strip-trailing-cr")
      )

;;(setq dont-auto-save-files '("passwords"))
;;(defun cancel-auto-save-maybe ()
;;  (if (member
;;	   (file-name-nondirectory buffer-file-name)
;;	   dont-auto-save-files)
;;    (auto-save-mode nil)))
;;(add-hook 'find-file-hooks (function cancel-auto-save-maybe))
(condition-case nil (progn (require 'crypt++)
  (crypt-rebuild-tables)
  (setq crypt-encryption-alist 
	(cons '(gpg-pub "[€-Ÿ]\\|^-----BEGIN PGP MESSAGE\\|^Salted__" "\\`
\\|^\\(..\\)?\\([]
\\|
[]\\)\\|^From \\|^;ELC" "\\(\\.gpg\\)$" "gpg" "gpg" ("--batch" "--quiet" "--armor" "--always-trust" "--encrypt" "--recipient" "ht" "--recipient" "ht" "-o" "-") ("--batch" "--quiet" "-o" "-" "--passphrase-fd" "0") "GPG" nil t t)
	      crypt-encryption-alist ))
  (setq crypt-encryption-type 'gpg-pub)
  (setq crypt-confirm-password t)
  (remove-hook 'after-init-hook 'crypt-rebuild-tables)) (error nil))
;; don't allow rebuild tables or we lose the
;; new entry above

;;; try to keep ecb and senator from running when we're iconified
;(add-hook 'unmap-frame-hook (lambda (f) (disable-timeout itimer-timer)))
;(add-hook 'map-frame-hook (lambda (f) (itimer-timer-wakeup)))

(defconst Electric-buffer-menu-mode-font-lock-keywords
   (purecopy
    (list
     '("^ MR Buffer.*"                 . font-lock-preprocessor-face) ;hdr 1
	'("^ -- ------.*"              . font-lock-preprocessor-face) ;hdr 2
	'("^\\(....Man: .*\\)" 1 font-lock-variable-name-face t) ;Manpg (new)
	'("^[. ][*][^%].[^*].*"        . font-lock-comment-face)	;Mod x temp
	'("^....[*]Buffer List[*].*"   . font-lock-doc-string-face) ;Buffer list
	'("^\\(....[*]shell.*\\)"      1 font-lock-reference-face t) ;shell buff
	'("^....[*].*"                 . font-lock-string-face) ;Temp buffer
	'("^....[+].*"                 . font-lock-keyword-face) ;Mail buffer
	'("^....[A-Za-z0-9/]*[-][+].*" . font-lock-keyword-face) ;Mail buffer
	'(".*Dired.*"                  . font-lock-function-name-face)
	)))
 ; This hook run after buffer formatted, so it is necessary to re-fontify it...
 (add-hook 'electric-buffer-menu-mode-hook
	   '(lambda ()
	      (font-lock-mode 1)
	      (font-lock-fontify-buffer)))

(cond ((eq (key-binding "\e\e") 'keyboard-escape-quit)
       ;; 21.5, windows
       (define-key global-window-system-map "\e\e" nil)
       (global-set-key "\M-\e:" 'eval-expression))
      ((null (key-binding "\e\e:"))
       ;; 21.5, tty
       (global-set-key "\M-\e:" 'eval-expression)))

(add-to-list 'load-path (expand-file-name "~/.xemacs/site-lisp/nxml-mode-20041004") t)
(add-to-list 'auto-mode-alist '("\\.xq[ml]?$" . xquery-mode))
(autoload 'xquery-mode "xquery-mode" "A Major mode for editing xquery.")
(autoload 'refer "refInsert" "Replace a string with a 'footnote' reference")

(if (featurep 'mule)
    (progn (set-language-environment "UTF-8")
	   ;(set-default 'buffer-file-coding-system 'mswindows-multibyte-unix)

	   ;; Fix for emacs-based incompatibility in new ediff -- remove eventually!!!!
	   ;(define-coding-system-alias 'emacs-internal 'escape-quoted)
	   ))