;;; 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

;;; HACK to deal with current x-crash workaround that I use a tty-launched
;;; xemacs via gnuclient from an X environment
;;; Not sure this is still needed 2023-10-07
(if (and (eq
	  (device-type (frame-device (get-frame-for-buffer (current-buffer))))
	  'x)
	 (not (getenv "DISPLAY")))
    (progn (message "setting DISPLAY in env")
	   (setenv "DISPLAY" ":0")))

(setq user-full-name "Henry S. Thompson")

(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)
		("\\.dsl$" . lisp-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"))))

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

(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)
    (progn
      (require 'lemacs-compat)))

(if window-system
    (progn
      (add-hook 'sh-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 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)))
      ))

      
(site-caseq (edin
	     (setq sgml-catalog-files '("catalog" "/afs/inf.ed.ac.uk/user/h/ht/lib/sgml/catalog"))))

(if (string-match "Lucid" emacs-version)
    ;; lemacs only goes here
  (progn
    (message "lem")
    ;; DICE comes here 2012-01-13
    (setq package-get-remove-copy nil)
    (require 'mail-abbrevs)
    (setq bbdb-north-american-phone-numbers-p nil)
    (setq bbdb-use-pop-up nil)
    (setq bbdb-complete-name-allow-cycling t
	  bbdb-completion-type 'primary-or-name)
    (setq bbdb-quiet-about-name-mismatches t)
    (setq bbdb-always-add-addresses t)
    (setq bbdb-new-nets-always-primary t)
    (site-caseq (edin
		 (setq bbdb-file "/disk/scratch/mail/.bbdb")))
    (setq bbdb-hashtable-size 24203)
    (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
	  (message "window-system-1")
	  ;; DICE comes here 2012-01-13
	  (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)))))
	  (set-face-background 'modeline '((x) . "lightgrey"))
	  	(defun ht-rooms-setup (&optional arg)
	      (interactive)
	      (require 'rooms)
	      (require 'mail-extras)
	      (require 'diary)
	      (let ((scr (selected-frame)))
					;	    (sit-for 5)
		(load "ht-rooms.config" nil t)
		;; for ecclerig viewed from paul
		(if (eq (device-pixel-width (selected-device)) 1920)
		    (progn
		      (unwind-protect
			  (make-screen-for-room "diary" "+1219" "+68"))
		      (unwind-protect
			  (make-screen-for-room "elisp" "+1185" "+102"))
		      (unwind-protect
			  (make-screen-for-room "news" "+1253" "+34")))
		  ;; for ecclerig in office
		  (unwind-protect (make-screen-for-room "diary" "+1888" "+0"))
		  (unwind-protect (make-screen-for-room "elisp" "+1888" "+0"))
		  (unwind-protect (make-screen-for-room "news" "+1223" "+0")))
		(sit-for 1)
		(delete-frame scr))
	      (setq ht-default-config (current-window-configuration)))))
    ;; DICE comes here 2012-01-13
    (setq interprogram-paste-function (lambda ()
                                        (or (get-clipboard-foreign)
                                            (if (selection-exists-p)
						(get-selection-foreign)))))
    (load "device-type-hacking" t t)
    ;; override changed default, except in gnus
    (message "dth")
    (site-caseq (edin
		 (setq highlight-headers-follow-url-function
		       'browse-url-firefox
		       )
		 (setq browse-url-browser-function 'browse-url-firefox)
		 ))
    (message "gnus-init")
    (site-caseq ((edin markup maritain)
		 (require 'gnus-init)))
    )
  ;; vanilla v19 goes here
  ;; probably stale/broken
  (message "vanilla")
  (if window-system
      (progn
	(message "window-system-2")
	(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)))))
	(message "defined rooms 2")
	)))
(setq sgml-insert-missing-element-comment nil)
(load "psgml" nil t)
(load "psgml-edit" nil t)
(load "xml-hack" nil t)
(add-hook 'sgml-mode-hook 'sgml-fix-para)
  ;; v18 emacs only was here

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

;;; Moved from custom.el -- not customisable, I think. . .
(setq
 ecb-options-version "2.27"
 gnus-treat-display-smileys nil
 gnus-treat-from-picon nil
 gnus-treat-mail-picon nil
 gnus-treat-newsgroups-picon nil
 jde-enable-abbrev-mode t
 package-get-require-signed-base-updates nil
 pgg-passphrase-cache-expiry 36000
 pui-package-install-dest-dir "/afs/inf.ed.ac.uk/user/h/ht/.xemacs/xemacs-packages"
 efs-ftp-program-args '("-i" "-n" "-g" "-v")
 efs-use-passive-mode t ; actually turns it _off_ !
)

(custom-set-faces
 '(font-lock-builtin-face ((((type x mswindows)(class color)(background light))(:foreground "Purple"))(((type tty)(class color))(:foreground "magenta"))))
 '(font-lock-comment-face ((((type x mswindows)(class color)(background light))(:foreground "blue4"))(((type tty)(class color))(:foreground "blue"))))
 '(font-lock-constant-face ((((type x mswindows)(class color)(background light))(:foreground "CadetBlue"))(((type tty)(class color))(:foreground "cyan"))))
 '(font-lock-doc-string-face ((((type x mswindows)(class color)(background light))(:foreground "green4"))(((type tty)(class color))(:foreground "green"))))
 '(font-lock-function-name-face ((((type x mswindows)(class color)(background light))(:foreground "brown4"))(((type tty)(class color))(:foreground "cyan" :bold))))
 '(font-lock-keyword-face ((((type x mswindows)(class color)(background light))(:foreground "red4"))(((type tty)(class color))(:foreground "red" :bold))))
 '(font-lock-preprocessor-face ((((type x mswindows)(class color)(background light))(:foreground "blue3"))(((type tty)(class color))(:foreground "cyan" :bold))))
 '(font-lock-reference-face ((((type x mswindows)(class color)(background light))(:foreground "red3"))(((type tty)(class color))(:foreground "red"))))
 '(font-lock-string-face ((((type x mswindows)(class color)(background light))(:foreground "green4"))(((type tty)(class color))(:foreground "green" :bold))))
 '(font-lock-type-face ((((type x mswindows)(class color)(background light))(:foreground "steelblue"))(((type tty)(class color))(:foreground "cyan" :bold))))
 '(font-lock-variable-name-face ((((type x mswindows)(class color)(background light))(:foreground "magenta4"))(((type tty)(class color))(:foreground "magenta" :bold))))
 '(font-lock-warning-face ((((type x mswindows)(class color)(background light))(:foreground "Red" :bold))(((type tty)(class color))(:foreground "red" :bold))))
)

(custom-set-faces
 '(modeline (
             (((type x mswindows)(class color))
              (:foreground "black" :background "gray80"))
             (t
               (:foreground "black" :background "white"))))
 '(modeline-buffer-id (
             (((type x mswindows)(class color))
              (:foreground "blue4" :background "gray80"))
             (((type tty)(class color))
              (:foreground "blue" :background "white"))
             (t
               (:foreground "black" :background "white" :bold t))))
 '(modeline-mousable (
             (((type x mswindows)(class color))
              (:foreground "firebrick" :background "gray80"))
             (((type tty)(class color))
              (:foreground "red" :background "white"))
             (t
               (:foreground "black" :background "white"))))
 '(modeline-mousable-minor-mode (
             (((type x mswindows)(class color))
              (:foreground "green4" :background "gray80"))
             (((type tty)(class color))
              (:foreground "green" :background "white" :bold t))
             (t
               (:foreground "black" :background "white"))))
)

(cd (user-home-directory))

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

(ht-custom-size)