;;; GNU Emacs init file for Henry Thompson
;;; This part shared between all hosts
;;; This part is my personal stuff, not for other incarnations
;;; initialisation file for Emacs, that is, (l)emacs and epoch common
;;; Last edited: Fri Sep 25 09:22:22 1992
;;; Edit history since port:  made load-path not site-dependant
;;; split into common-init for all my incarnations and pers-init for private
;;; added lemacs compatibility

;;; mail stuff
(setq mail-archive-file-name "~/mail/cpy/general")
(setq rmail-dont-reply-to-names "hthompso*\\|h\\.thompso*\\|ht@*" )
(set-default 'ht-last-file (expand-file-name "~/mail/"))
(setq ht-diary-file-name "~/mail/diary.babyl")
(setq mail-append-host "inf.ed.ac.uk")
(setq user-full-name "Henry S. Thompson")
(setq user-mail-address "ht@inf.ed.ac.uk")
(setq mail-host-address "inf.ed.ac.uk")

;; new mail hackery
(site-caseq ((edin ircs ldc)
	     (setq rmail-spool-directory (file-name-as-directory
					       (concat rmail-spool-directory
						       "ht-mail")))))

;; sending mail on the road
;; [moved to mail-from-m.el, which is required by gnus-init.el

;; don't know why this is necessary
(site-caseq ((edin)
	     (setq rmail-primary-inbox-list
		   (list (concat rmail-spool-directory "ht")))))

;; Perforce

;;(setq p4-global-server-port "zorg.milowski.com:1666")
;;(setenv "P4PORT" "zorg.milowski.com:1666")
;;(setenv "P4CLIENT" "MarkupMan")
;;(setenv "P4CONFIG" ".p4env")
;;(load-library "p4")
;;(setq p4-use-p4config-exclusively t)
;;(p4-set-p4-executable "/c/Program Files/Perforce/p4.exe")
(setq vc-command-messages t)

(setq minibuffer-max-depth nil)
(defun run-kcl ()
  "Run an inferior kcl process"
  (interactive)
  (switch-to-buffer (make-shell "kcl" "kcl"))
  (inferior-lisp-mode))

(require 'mdn-extras)
(setq auto-mode-alist
      (append '(("/perl/" . perl-mode)
		("\\.scm$" . scheme-mode))
	    auto-mode-alist))
(setq inferior-lisp-program "scheme")
;;; for scheme
(put 'letrec 'lisp-indent-function 1)
(put 'case 'lisp-indent-function 1)

(site-caseq (parc (nconc load-path '("/import/local/emacs/gnus-3.13/"))
		  (setq rmail-primary-inbox-list
			'("~/mbox" "/net/piglet/usr/spool/mail/$USER")))
	    (edin (setq load-path (cons
				   "/home/ht/emacs/shared/gnus-5.0.15/lisp"
				   load-path))))

(defun run-sicstus ()
  "Run an inferior Prolog process, input and output via buffer *prolog*."
  (interactive)
  (if (not (boundp 'prolog-mode-map))
      (let ((load-path (cons
			(site-caseq (parc "/import/prolog-1.8/emacs")
				    (edin "??"))
			load-path)))
	(load "prolog" nil t)))
  (require 'shell)
  (switch-to-buffer (make-shell "prolog" (site-caseq (edin "sicstus")
						     (parc "prolog"))))
  (inferior-prolog-mode))

(site-caseq ((laptop maritain))
	    (t(require 'hist)
	      (rplacd (assoc "*shell*" hk-pat-table)
		      "[a-z]+<[0-9]+>: ")))

;; turn off suspend-emacs -- use pause-emacs (^X.) instead
(global-unset-key "\C-Z")
(global-unset-key "\C-x\C-z")

(global-set-key "\C-xl" (function goto-line))

;(require 'repl-comment)

;(require 'compress)

(if (string-match "Lucid" emacs-version)
    (site-caseq ((laptop maritain))
		(t(require 'lemacs-compat))))

(if (boundp 'epoch::version)
    ;; epoch only goes here
    (progn
      (if (string-match "4\\."emacs-version)
	  (load "motion4" nil t)
	(load "motion" nil t))
      (redisplay-frame)

      (require 'alarm)
      (idle-save 15)

      (defun ht-rooms-setup (&optional arg)
	(interactive)
	(redisplay-frame)
	(require 'mail-extras)
	(require 'diary)
	(require 'my-news)
	(let ((scr (current-frame)))
	  (load "ht-rooms-epoch.config" nil t)
	  (unwind-protect (make-frame-for-room "diary" "-0" "+130"))
	  (unwind-protect (make-frame-for-room "elisp" "-25" "+148"))
	  (unwind-protect (make-frame-for-room "news" "-50" "+166"))
	  (unwind-protect (make-frame-for-room "mail" "-75" "+184"))
	  (epoch::delete-frame scr))
	;; presumably this is now frame local, so not quite the right thing.
	(setq ht-default-config (current-window-configuration)))
      ))
(if (string-match "^\\(19\\|2\\)" emacs-version)
    (progn
      ;; common v19
      (if window-system
	  (progn
	    (add-hook 'sh-mode-hook '(lambda ()
				      (font-lock-mode 1)))
	    (add-hook 'lsl-mode-hook '(lambda ()
				    (font-lock-mode 1)))
	    (add-hook 'perl-mode-hook '(lambda ()
				    (font-lock-mode 1)))
	    (add-hook 'emacs-lisp-mode-hook '(lambda ()
					  (font-lock-mode 1)))
	    (add-hook 'lisp-mode-hook '(lambda ()
				    (font-lock-mode 1)))
	    (add-hook 'sgml-mode-hook '(lambda ()
				    (if (not
					 (boundp 'sgml-font-lock-keywords))
				     (load "sgml-font-lock-keywords" t t))
				    (setq adaptive-fill-mode nil)
				    (font-lock-mode 1)
				    ))
	    (add-hook 'c-mode-hook '(lambda ()
				    (font-lock-mode 1)))
	    (add-hook 'c++-mode-hook '(lambda ()
				    (font-lock-mode 1)))
	    (add-hook 'scheme-mode-hook
		  '(lambda ()
		     (setq
		      scheme-font-lock-keywords
		      (if (or
			   (boundp 'lisp-font-lock-keywords)
			   (load "lisp-font-lock-keywords" t t))
			  lisp-font-lock-keywords))
		     (font-lock-mode 1)))
	    (add-hook 'python-mode-hook '(lambda ()
				      (font-lock-mode 1)))
	    (setq py-python-command "//c/Program Files/Python22/python")
	    (setq sgml-insert-missing-element-comment nil)
	    (load "psgml" nil t)
	    (load "psgml-edit" nil t)
	    ;; (load "xml-hack" nil t)
;	    (setq sgml-catalog-files '("CATALOG" "f:/lib/sgml/catalog"))
	    (if (string-match "i386" (emacs-version))
		(progn (defun win32-get-clipboard-data-cmd ()
			 (interactive)(insert (win32-get-clipboard-data)))
		       (global-set-key
			   "\C-x\C-y" 'win32-get-clipboard-data-cmd)))
	    ;; gnus
;	    (setq mail-signature t)

	    ;; loading gnus postponed to e.g. mail-from-delphix, q.v.

					;	    (require 'gnus-min)
	    ))
      (load "gnus-init" nil t)

;;      (require 'idle)
;;      (idle-save 15)
      
      (if (string-match "Lucid" emacs-version)
	  ;; lemacs only goes here
	  (progn
	    (message "lem")
	      (setq bbdb-north-american-phone-numbers-p nil)
	      (setq bbdb-use-pop-up nil)
	      (require 'mail-abbrevs)
	      (require 'bbdb)
	      ;(require 'bbdb-rmail)
	      (require 'bbdb-com)	; to fix auto-fill
	      (setq mail-use-rfc822 nil)
	      (add-hook 'gnus-summary-mode-hook
			(function (lambda ()
				    (make-local-variable 'mail-use-rfc822)
				    (setq mail-use-rfc822 t))))
	      (if (>= emacs-major-version 21)
		  (progn
		    (add-hook 'gnus-startup-hook 'bbdb-insinuate-gnus)
		    (add-hook 'gnus-startup-hook 'bbdb-insinuate-message)))
	      (fset 'bbdb-auto-fill-function (lambda () t)) ; ditto
	      (fmakunbound 'bbdb-orig-rmail-expunge)
	      ;(add-hook 'rmail-mode-hook 'bbdb-insinuate-rmail)
	      (add-hook 'gnus-startup-hook 'bbdb-insinuate-gnus)
	      (add-hook 'mail-setup-hook 'bbdb-insinuate-sendmail)
	      (setq bbdb-dwim-net-address-allow-redundancy t)
	      (add-hook 'mail-setup-hook 'bbdb-define-all-aliases)
	      (add-hook 'gnus-message-setup-hook 'bbdb-define-all-aliases)
	      (if (not (fboundp 'define-mail-abbrev))
		  ;; fix a bug which crashes occasionally -- see also
		  ;; bbdb-com
		  (progn
		    (require 'sendmail)
		    ;(defadvice sendmail-pre-abbrev-expand-hook
		     ; (before bbdb-rebuilt-all-aliases activate)
		     ; (bbdb-rebuilt-all-aliases))
		    ))
	      (defun gnuserv-start-maybe ()
		(if (not (frame-live-p gnuserv-frame))
		    (gnuserv-start)))
;;;	      (require 'itimer)
;;;	      (start-itimer "gsr" 'gnuserv-start-maybe
;;;			    1200 1200 nil nil)

	    (if window-system
		(progn
		  (require 'highlight-headers)
		  (defun rmail-fontify-headers ()
		    (highlight-headers (point-min) (point-max) t))
		  (add-hook 'rmail-show-message-hook 'rmail-fontify-headers)
		  (setq dired-mode-hook
			'(lambda ()
			   (font-lock-mode 1)
			   (define-key dired-mode-map
			     [button2] '(lambda (click)
					  (interactive "e")
					  (mouse-set-point click)
					  (dired-advertised-find-file)))))
;;		  (setq highlight-headers-follow-url-function
	;;		'highlight-headers-ht-follow-url-netscape
		;;	browse-url-browser-function
			;;'highlight-headers-ht-follow-url-netscape)
		  ))
;;	    (load "~rjc/public_html/device-type-hacking.el")
	    (load "perl-mode" nil t)
	    (defun ht-rooms-setup (&optional arg)
	      (interactive)
	      (require 'mail-extras)
	      (require 'diary)
	      (require 'my-news)
	      ;; override changed default, except in gnus
	      (setq mail-use-rfc822 nil)
	      (add-hook 'gnus-summary-mode-hook
			(function (lambda ()
				    (make-local-variable 'mail-use-rfc822)
				    (setq mail-use-rfc822 t))))
	      (if (>= emacs-major-version 21)
		  (progn
		    (add-hook 'gnus-startup-hook 'bbdb-insinuate-gnus)
		    (add-hook 'gnus-startup-hook 'bbdb-insinuate-message)))
	    (defun ht-rooms-setup (&optional arg)
	      (interactive)
	      (require 'mail-extras)
	      (require 'diary)
	      (let ((scr (selected-frame)))
					;	    (sit-for 5)
		(load "ht-rooms.config" nil t)
		(unwind-protect (make-screen-for-room "diary" "0" "+62"))
					;           (sit-for 5)
		(unwind-protect (make-screen-for-room "elisp" "-25" "+79"))
					;	    (sit-for 5)
		(unwind-protect (make-screen-for-room "news" "-50" "+96"))
					;           (sit-for 5)
		(unwind-protect (make-screen-for-room "mail" "-75" "+113"))
		(sit-for 1)
		(delete-screen scr))
	      (setq ht-default-config (current-window-configuration)))))
	;; vanilla v19 goes here
	(if window-system
	    (progn
	      (defvar ht-frame-parameter-mods 
		'((auto-raise . t)
		  (auto-lower . nil)
		  (cursor-type . bar)))
	      (nconc
	       (site-caseq ((laptop maritain) (list '(height . 35)))
			   (t
			    (list
			      '(font .
				    "-adobe-courier-medium-r-normal--14-*"))))
	       ht-frame-parameter-mods
		)
	      ;; if we have X, we have ISO-Latin-1, so
	      ;; set char codes 128--255 to display as themselves.
	      (require 'disp-table)
	      (standard-display-8bit 161 255)
;	      (transient-mark-mode t)
	      ;; hightlight searching in bold
	      (setq search-highlight t)
	      (make-face 'isearch)
	      (copy-face 'bold 'isearch)
;	      (set-face-underline-p 'region t)
;	      (set-face-background 'region "white")
;	      (set-face-foreground 'region "black")
;	    (setq c++-font-lock-keywords 'undef)
;	    (setq c-font-lock-keywords 'undef)
	    (modify-frame-parameters
	     nil
	     ht-frame-parameter-mods)
	  (setq default-frame-alist
		(append
		 ht-frame-parameter-mods default-frame-alist))
	      ;; fix cut and paste
	      (setq interprogram-paste-function nil
		    interprogram-cut-function nil)
	      (defun ht-mouse-set-region (click) "set region and primary selection"
		(interactive "e")
		(mouse-set-region click)
		(x-set-selection "PRIMARY" (buffer-substring (point)(mark))))
	      (defun ht-mouse-drag-region (click)
		"drag region and set primary selection"
		(interactive "e")
		(mouse-drag-region click)
		(if mark-active
		    (x-set-selection "PRIMARY" (buffer-substring (point)(mark)))))
	      (global-set-key [drag-mouse-1] (function ht-mouse-set-region))
	      (global-set-key [down-mouse-1] (function ht-mouse-drag-region))
	      (defun ht-mouse-insert-primary (click)
		"set point and insert primary selection"
		(interactive "e")
		(mouse-set-point click)
		(push-mark nil nil t)
		(insert (x-selection)))
	      (global-set-key [mouse-2] (function ht-mouse-insert-primary))
	      (setq dired-mode-hook
		  '(lambda ()
		     (font-lock-mode 1)
		     (define-key dired-mode-map
		       [mouse-2] '(lambda (click)
				    (interactive "e")
				    (mouse-set-point click)
				    (dired-advertised-find-file)))))

	      (defun ht-rooms-setup (&optional arg)
		(interactive)
		(require 'mail-extras)
		(require 'diary)
		(require 'my-news)
		;; override changed default, except in gnus
		(setq mail-use-rfc822 nil)
		(add-hook 'gnus-summary-mode-hook
			  (function (lambda ()
				      (make-local-variable 'mail-use-rfc822)
				      (setq mail-use-rfc822 t))))
		(let ((scr (selected-frame)))
		  (load "ht-rooms.config" nil t)
		  (unwind-protect (make-frame-for-room "elisp" "-25" "-58"))
		  (unwind-protect (progn
				    (make-frame-for-room "news" "-50" "-40")
				    ))
		  (unwind-protect (progn
				    (make-frame-for-room "mail" "-75" "-22")
				    ))
		  (unwind-protect (progn
				    (make-frame-for-room
				     "diary"
				     "-0"
				     (concat
				      "+"
				      (format
				       "%d"
				       (-
					(cdr
					 (assoc
					  'top
					  (frame-parameters
					   (cdr
					    (assoc
					     "elisp"
					     frames-table)))))
					18))))
				    ))
		  (make-frame-invisible scr))
		(setq ht-default-config (current-window-configuration))))))
      (setq sgml-insert-missing-element-comment nil)
      (add-hook 'sgml-mode-hook 'sgml-fix-para)
)
  ;; v18 emacs only goes here
  (progn
    (require 'compress)
    (defun ht-rooms-setup (&optional arg)
      (interactive)
      (require 'mail-extras)
      (require 'diary)
      (require 'my-news)
      (load "ht-rooms.config" nil t)
      (setq ht-default-config (current-window-configuration)))))

(defun ht-rooms-resetup ()
  (interactive)
  (setq rooms-table nil)
  (setq frames-table nil)
  (ht-rooms-setup))

(defun sgml-fix-para ()
  (setq paragraph-separate
	"</[^>]*>\n\\([ \t]+\\| \\)")
  (setq paragraph-start
       	"^[ \t]*</?[A-Za-z._-]+[ >]"))

(defun highlight-headers-ht-follow-url-netscape (url &optional arg)
  (message "Sending URL to Netscape...")
  (save-excursion
    (set-buffer (get-buffer-create "*Shell Command Output*"))
    (erase-buffer)
    (if (equal 0 (call-process "netscape" nil t nil "-display" ":0.0"
				   "-remote"
				   (concat "openURL(" url ")")))
	;; it worked
	nil
      ;; it didn't work, so start a new Netscape process.
      (call-process "netscape" nil 0 nil url)))
  (message "Sending URL to Netscape... done"))

(site-caseq (laptop (defun system-name () "francis.markup.co.uk")))

(cd (user-home-directory))

(require 'misc) ; used to be in common-init...

(ht-custom-size)