;;; 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 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
;(copy-coding-system (find-coding-system 'iso-8859-1) 'iso-8859-15)

(if (featurep 'mule)
;;    (set-language-environment "Latin-1")  WHY WAS THIS HERE???
    (set-language-environment "UTF-8"))
(put 'eval-expression 'disabled nil)	;enable minibuffer
(put 'narrow-to-region 'disabled nil)	; and this one too
(setq inhibit-startup-message t)	;shhh!
(setq gc-cons-threshold 5000000)        ;for gnus, mostly
(when (and (fboundp 'device-type)       ; xemacs only
	   (eq (device-type) 'tty))
  (setq frame-background-mode 'light))  ; override stupid default for TTY in 
(setq default-custom-frame-properties nil) ;force recomputation
(setq gnuserv-frame-plist '(background-mode light))
(if (fboundp 'initialize-custom-faces)
    (initialize-custom-faces
     ))
(setq require-final-newline 'ask)
(setq mode-require-final-newline 'ask)
(setq enable-recursive-minibuffers t)	;allow extended commands
(setq rmht-allow-autosave nil)
(setq next-line-add-newlines t)
(setq line-number-mode t)
(setq column-number-mode t)

;;; adaptive fill takes account of para numbering
(setq adaptive-fill-regexp nil)
(add-hook 'message-mode-hook
	  (lambda () (setq adaptive-fill-regexp nil)))

(defun ht-fill-with-bullets ()
  (if (and buffer-undo-list (listp 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 adaptive-fill-function 'ht-fill-with-bullets)

(site-caseq (parc
	     (setq default-major-mode 'text-mode)
	     (setq text-mode-hook 'turn-on-auto-fill) ;always use fill
	     (setq version-control t)	;gimme numbers
	     (setq trim-versions-without-asking t) ; but trim quietly
	     ))

(if (not (string-equal (getenv "ORIG_TERM")
				   "dialup"))
    (if (fboundp 'set-input-mode)
	(set-input-mode nil nil t)
      (setq meta-flag t)		;check that bit!
      ))

(setq load-path (append
		 (site-caseq ((edin ledin edin_e)
			      (list 
				    (expand-file-name "~ht/emacs/local")
				    (expand-file-name "~ht/emacs/shared")))
			     (t (list (expand-file-name "~/emacs/local")
				      (expand-file-name "~/emacs/shared"))))
;;		 (site-caseq (ledin
	;;	       (directory-files "/group/ltg/projects/lcontrib/lib/xemacs/xemacs-packages/lisp" t "[^.]" t 'dir)))
		 load-path))

(site-caseq (ledin
	     (setq data-directory-list
		   (cons
		    "/group/ltg/projects/lcontrib/lib/xemacs/xemacs-packages/etc/"
		    data-directory-list))))

(if (string-match "Lucid" emacs-version)
    ;; epoch as last resort
    (setq load-path (mapcar
		     (function
		      (lambda (d)
			  (file-name-as-directory d)))
		     (append (cons (expand-file-name "~ht/emacs/lucid")
;				   (cons (expand-file-name
;					  "~ht/emacs/v19")
					 load-path
;					 )
			     )
			    '(
;			      "/usr/local/share/lib/emacslocal/lisp"
	;		      "/usr/contrib/share/lib/epoch-4.2/epoch-lisp"
		;	      "/usr/contrib/share/lib/epoch-4.2/lisp"
			;      "/usr/local/share/lib/emacs/lisp"
			 ;     "/usr/contrib/share/lib/emacs/lisp"
			      )))))

(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)

;;; Can't use nconc in emacs :-(
(setq auto-mode-alist
      (append auto-mode-alist (list '("\\.gwm$" . lisp-mode))))

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

(setq auto-mode-alist 
      (append
       auto-mode-alist
       (list (cons "\\.py$" 'python-mode)
	     '("\\.xml$" . xml-mode)
	     '("\\.xsd$" . xml-mode)
	     '("\\.xsl$" . xml-mode)
	     (cons "\\.sgm$" 'sgml-mode)
	     (cons "\\.sgml$"  'sgml-mode)
	     (cons "\\.ent$"  'sgml-mode)
	     (cons "\\.dtd$" 'sgml-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-*")
			((ledin 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)))
		  ((ledin 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 (string-match "^\\(19\\|2\\)" emacs-version)
    ;; 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)


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


      (if (and (not (string-match "Lucid" emacs-version))
	       (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 edin_e ledin)
			      '("/usr/local/share/lib/info"
				"/usr/contrib/share/info/"))
			     (ldc  '("/afs/inf.ed.ac.uk/user/h/ht/ldc2/info/"))
			     (ircs '("/pkg/gnu-emacs-18.58/info")))))
	(setq Info-directory-list
		(append
		 Info-directory-list
		 (site-caseq ((edin edin_e ledin)
			      '("/usr/local/share/lib/info"
				"/usr/contrib/share/info/"))
			     (ldc  '("/afs/inf.ed.ac.uk/user/h/ht/ldc2/info/"))
			     (ircs '("/pkg/gnu-emacs-18.58/info"))))))
      (if window-system
	  (progn
;	    (setq load-path
	;	      (cons (expand-file-name
		;	     "~ht/emacs/v19/font-lock")
			;    load-path))
	    (load "font-lock" nil t)
	    (if (string-match "Lucid" emacs-version)
		(progn
		  (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)
			     (defun extent-data (extent)
			       (extent-property extent 'data)))
		    (load "font-lock-mods" nil t)))
	      (site-caseq (edin_e)
			  (t (load "font-lock-mods" 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)
;; See custom.el for efs-ftp stuff. . .
;		 (site-caseq (edin ; get through local firewall
;			      (setq efs-use-passive-mode t)
;			      (setq efs-ftp-program-name "gftp"))
;			     (ledin	; don't try kerberos authentication
;			      (setq efs-ftp-program-args
;				    '("-u" "-i" "-n" "-g" "-v"))))
		 (define-key read-file-name-map "~" 'minibuffer-electric-tilde)
		 (define-key read-file-name-must-match-map "~" 'minibuffer-electric-tilde)

		 (load "man" nil t)
		 ;; (provide 'ange-ftp) ; incompatible if loaded, better error
		 ;; 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-*")
		 (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"))
			       (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"))))))
	(load "man" nil t)
	))
  ;; emacs 18 only goes here
    (define-key minibuffer-local-ns-map " " 'minibuffer-complete)
    (require 'vc))

(site-caseq (edin_e)
  (t (require 'misc)			; define M-e, M-m, C-X-., etc.
     (require 'rooms)
     (require 'refInsert)))
(condition-case nil
    (progn
      (require 'recent-files)
      (setq recent-files-non-permanent-submenu t)
      (recent-files-initialize))
  (error nil))
(setq vc-initial-comment t)

(if (getenv "FLOW_CONTROL")
    (hack-xon))

(site-caseq (edin_e)
  (t (require 'hackbs)))
;(require 'ecb-autoloads)
(site-caseq ((edin ledin)
	     (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" "--pinentry" "loopback" "--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)
	     ;; don't allow rebuild-tables or we lose the
	     ;; new entry above
	     )
	    (t	(shouldnt-happen)			;(require 'crypt) ???
	     ))
(mwheel-install)

(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)))