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

(shell-command "hostname")
(setq hostname (buffer-substring nil nil "*Shell Command Output*"))
(setq hostname (intern
		(downcase (substring hostname 0 (- (length hostname) 1)))))
(defvar user-name (user-login-name)) 
(defvar site-name hostname "for site-specific initialisation")

(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!
(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 minibuffer-max-depth nil)
(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)))
(setq adaptive-fill-function
  (lambda ()
    (if (and buffer-undo-list (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)
				      (turn-on-auto-fill) ;always use fill
				      )))

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

(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
		 (list (expand-file-name "~/lib/xemacs")
		       ;; next too are for private copies of _old_ stuff
		       (expand-file-name "~/lib/xemacs/shared")
		       (expand-file-name "~/lib/xemacs/lucid"))
		 load-path))
(message "load-path %s" load-path)

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


; 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 '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 
      (append
       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 (string-match "^\\(19\\|2\\)" emacs-version)
    ;; common v19
    (progn
      (message "common v19")
      (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/lcontrib_focal/share/lib/info/")))))
	(setq Info-directory-list
		(append
		 Info-directory-list
		 (site-caseq (edin 
			      '("/usr/local/share/lib/info"
				"/usr/lcontrib_focal/share/lib/info/"))))))

      (if window-system
	  (progn
	    (message "common-window-system")
	    (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)))
	    (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!
		  (message "ntb")
		  (if (or (> emacs-major-version 19)
			  (> emacs-minor-version 12))
		      (progn (set-specifier top-toolbar-visible-p nil)
			     (set-specifier modeline-shadow-thickness 0)
			     (set-specifier default-gutter-visible-p nil)
			     (defun extent-data (extent)
			       (extent-property extent 'data)))))
	      (site-caseq (edin_e)
			  (t (load "font-lock-mods" nil t))))

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

      (if (string-match "Lucid" emacs-version)
	  ;; xemacs 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)

		 )
	;; emacs 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")))
			       (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"))))))
	(load "man" nil t)
	))
  ;; emacs 18 only goes here
    (define-key minibuffer-local-ns-map " " 'minibuffer-complete)
    (require 'vc))

;(require 'misc) now in pers-init

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

(add-hook 'text-mode-hook (lambda nil (abbrev-mode 1)))

(global-set-key "\M-o" (function other-frame))
(require 'recent-files)
(setq recent-files-non-permanent-submenu t)
(recent-files-initialize)
(setq vc-initial-comment t)

(setq ediff-diff-options "-a "
      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")
      )

(require 'crypt)
(crypt-rebuild-tables)
;; This only works on ecclerig (Ubuntu focal) with
;;   pinentry-program /usr/bin/pinentry-curses
;; in ~/.gnupg/gpg-agent.conf
;; Possibly also need to do
;; gpg-connect-agent reloadagent /bye
;; That's not enough... Need  "--pinentry" "loopback" (as well?)
;; See https://superuser.com/a/521027
(setq crypt-encryption-alist 
   (cons '(gpg-pub
	   "[€-Ÿ]\\|^-----BEGIN PGP MESSAGE\\|^Salted__"
	   "\\`�
\\|^\\(..\\)?\\([]
\\|
[]\\)\\|^From \\|^;ELC"
	   "\\(\\.gpg\\)$"
	   "gpg"
	   "gpg"
	   ("--batch" "--quiet" "--passphrase-fd" "0" "--pinentry-mode" "loopback" "--armor" "--always-trust" "--encrypt" "--recipient" "ht" "-o" "-")
	   ("--batch" "--quiet" "--passphrase-fd" "0" "--pinentry-mode" "loopback" "--decrypt" "-o" "-")
	   "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

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


(when (and (featurep 'mule) (functionp 'current-locale))
  (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)
       
  (require 'un-define)
  (set-coding-priority-list '(utf-8))
  (set-coding-category-system 'utf-8 'utf-8)
  ;; See mule-packages/mule-ucs/README.XEmacs for explanation of all this
  )

;;; make dired list directories first
(defadvice dired-insert-directory (before my-dired-insert-directory
                                   (dir-or-list switches &optional wildcard full-p))
  (setq switches (concat switches " --group-directories-first")))

(ad-activate 'dired-insert-directory) 

(defun ht-custom-size (&optional delta)
  (interactive)
  (if (fboundp 'device-pixel-width)
      (let ((pw (device-pixel-width (selected-device)))
            (ph (device-pixel-height (selected-device)))
	    (delta (or delta 0)))
	(message (format "pw: %s" pw))
        (cond ((= pw 2048)
		      ;; we're on a _really_ big external monitor
		      (set-frame-pixel-size (selected-frame) 900 1050)
		      (set-frame-position (selected-frame) (- 0 delta) (+ delta 0)))
; Old maritain
; 	      ((= pw 1920)
; 		      ;; we're on a 27" curved external monitor
; 		      (set-frame-pixel-size (selected-frame) 720 980)
; 		      (set-frame-position (selected-frame) (- -8 delta) (+ delta 2)))
	      ((= pw 1920)
	       (cond ((= ph 1080)
		      ;; we're on a 27" curved external monitor on Paul
		      (set-frame-pixel-size (selected-frame) 719 923)
		      (set-frame-position (selected-frame) (- 0 delta)
					  (+ delta 0)))
		     (t
		      ; New maritain via vncviewer
		      (set-frame-pixel-size (selected-frame) 720 980)
 		      (set-frame-position (selected-frame) (- -8 delta) (+ delta 2)))))
	      ((= pw 1904)
	       ;; we're on a 27" curved external monitor on Paul via XDMCP
	       (set-frame-pixel-size (selected-frame) 720 938)
	       (set-frame-position (selected-frame) (- -8 delta) (+ delta 2)))
	      ((= pw 1680)
	       ;; we're on a big external monitor
               (font-menu-set-font nil nil 10)
	       (set-frame-pixel-size (selected-frame) 900 1000)
	       (set-frame-position (selected-frame) (- -3 delta) (+ delta -20)))
              ((= pw 1097)
               ;; we're on an XPS 13, mag. 300%
               (require 'font-menu)
               (font-menu-set-font nil nil 9)
               (set-frame-pixel-size (selected-frame) 583 583); 80 x 39
               (set-frame-position (selected-frame) (- -5 delta) (+ delta -26)))
              ((= pw 1536)
               ;; we're on an XPS 13, mag. 250%
               (require 'font-menu)
               (font-menu-set-font nil nil 10)
               (set-frame-pixel-size (selected-frame) 670 782); 81 x 49
               (set-frame-position (selected-frame) (- -5 delta) (+ delta -26)))
              ((= ph 768)
               ;; we're on a narrow cinema-ratio laptop
               (set-frame-pixel-size (selected-frame) 690 710)
               (set-frame-position (selected-frame) (- -5 delta) (+ delta -26)))
              ((= ph 900)
               ;; we're on a cinema-ratio laptop
               (set-frame-pixel-size (selected-frame) 800 820)
               (set-frame-position (selected-frame) (- -3 delta) (+ delta -20)))
              ((= pw 1600)
               ;; we're on a big external monitor
               (set-frame-pixel-size (selected-frame) 900 1120)
               (set-frame-position (selected-frame) (- -3 delta) (+ delta -20)))
              ((= pw 1280)
               (cond ((= ph 720)
                      (set-frame-pixel-size (selected-frame) 700 655)
                      (set-frame-position (selected-frame) (- -3 delta)
					  (+ delta -30)))
                     (t
                      (set-frame-pixel-size (selected-frame) 700 960)
                      (set-frame-position (selected-frame) (- -3 delta)
					  (+ delta -20)))))))))