Mercurial > hg > xemacs
changeset 1:6c73c7af9cdb
DICE versions, before pruning
| author | Henry S. Thompson <ht@inf.ed.ac.uk> |
|---|---|
| date | Mon, 08 Feb 2021 12:28:16 +0000 |
| parents | 107d592c5f4a |
| children | dd557432d846 |
| files | shared/common-init.el shared/pers-init.el |
| diffstat | 2 files changed, 503 insertions(+), 0 deletions(-) [+] |
line wrap: on
line diff
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/shared/pers-init.el Mon Feb 08 12:28:16 2021 +0000 @@ -0,0 +1,503 @@ +;; 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 +(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"))) + +;;; mail stuff +(setq mail-archive-file-name (concat "/disk/scratch/mail/cpy/general/" + (format-time-string + "%Y-%m" (current-time)) + ".mbox")) + +(defun hand () + (interactive) + (insert-file "~/pers/hand.txt")) + +(setq rmail-dont-reply-to-names "hthompso*\\|h\\.thompso*\\|ht@*" ) +(setq rmail-show-mime nil) +(set-default 'ht-last-file (expand-file-name "/disk/scratch/mail/")) +(setq ht-diary-file-name "/disk/scratch/mail/diary.babyl") +(setq mail-append-host "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"))))) +;; don't know why this is necessary +(site-caseq ((edin) + (setq rmail-primary-inbox-list + (list (concat rmail-spool-directory "ht"))))) + +(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) +(require 'passwd) ; for shell login for kerberos +(setq auto-mode-alist + (append '(("/perl/" . perl-mode) + ("\\.scm$" . lisp-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 (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) + + (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))) + (setq perl-mode-hook '(lambda () + (font-lock-mode 1))) + (setq emacs-lisp-mode-hook '(lambda () + (font-lock-mode 1))) + (setq lisp-mode-hook '(lambda () + (font-lock-mode 1))) + (setq sgml-mode-hook '(lambda () + (if (not + (boundp 'sgml-font-lock-keywords)) + (load "sgml-font-lock-keywords" t t)) + (font-lock-mode 1) + )) + (setq c-mode-hook '(lambda () + (font-lock-mode 1))) + (setq c++-mode-hook '(lambda () + (font-lock-mode 1))) + (setq 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))) + (setq python-mode-hook '(lambda () + (font-lock-mode 1))) + )) + + + (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 + (if (< emacs-major-version 21) + (setq load-path + (append '("/usr/contrib/lib/xemacs/site-lisp/xml" + "/usr/contrib/lib/xemacs/site-lisp/psgml") + load-path)) +; (pui-add-install-directory +; "/net/sunsite.doc.ic.ac.uk/public/pub/Mirrors/ftp.xemacs.org/pub/xemacs/packages") +; (setq load-path (remove "/usr/contrib/lib/xemacs/xemacs-packages/lisp/gnus/" load-path)) + ;; DICE comes here 2012-01-13 + (setq package-get-remove-copy nil) + (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) + (setq bbdb-file "/disk/scratch/mail/.bbdb") + (setq bbdb-hashtable-size 24203) + (require 'bbdb) + ;(require 'bbdb-rmail) + (require 'bbdb-com) ; to fix auto-fill + (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) + (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 + ;; 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))))) + (setq highlight-headers-follow-url-function + 'browse-url-firefox + ;;browse-url-browser-function + ;;'browse-url-mozilla + ) + (setq browse-url-browser-function 'browse-url-firefox) + (set-face-background 'modeline '((x) . "lightgrey")))) + ;; DICE comes here 2012-01-13 + (load "device-type-hacking" t t) +;; (setq browse-url-mozilla-program "/usr/bin/X11/mozilla") + + ;; gnus + (setq nnml-directory (expand-file-name "/disk/scratch/mail/Mail") + gnus-secondary-select-methods + '((nnml "ht" + (gnus-show-threads nil) + (gnus-article-sort-functions + (gnus-article-sort-by-subject + gnus-article-sort-by-date)))) + gnus-home-directory "/disk/scratch/gnus" ; local disk + gnus-article-save-directory (expand-file-name "/disk/scratch/mail/Mail") + gnus-message-archive-method + `(nnfolder "archive" + (nnfolder-directory ,(expand-file-name + "/disk/scratch/mail/cpy")) + (nnfolder-active-file ,(expand-file-name + "/disk/scratch/cpy/active")) + (nnfolder-get-new-mail nil) + (nnfolder-inhibit-expiry t))) + + (load "gnus-init" nil t) + + ;; 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))) + ;; DICE comes here 2012-01-13 + (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) +; Formerly, for troutbeck +; (unwind-protect (make-screen-for-room "diary" "0" "+60")) +; ; (sit-for 5) +; (unwind-protect (make-screen-for-room "elisp" "0" "+73")) +; ; (sit-for 5) +; (unwind-protect (make-screen-for-room "news" "-50" "+85")) + ;; for ecclerig + (unwind-protect (make-screen-for-room "diary" "+1888" "+0")) + ; (sit-for 5) + (unwind-protect (make-screen-for-room "elisp" "+1888" "+0")) + ; (sit-for 5) + (unwind-protect (make-screen-for-room "news" "+1223" "+0")) + ; (sit-for 5) +; (unwind-protect (make-screen-for-room "mail" "-75" "+98")) + (sit-for 1) + (delete-frame scr)) + (setq ht-default-config (current-window-configuration)))) + ;; vanilla v19 goes here + (if window-system + (progn + (defvar ht-frame-parameter-mods + '((font . "-adobe-courier-medium-r-normal--14-*") + (auto-raise . t) + (auto-lower . nil) + (cursor-type . bar))) + ;; 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 load-path + (append '("/usr/contrib/lib/emacs/lisp/xml" + "/usr/contrib/lib/emacs/lisp/psgml") + load-path))) + (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 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")) + +;;; 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_ ! +) + +;;; The following duplicate settings in custom.el???? +(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")))) +) + +(defalias 'review (read-kbd-macro +"PhD SPC applicant SPC review, SPC please 4*<C-n> M-x insert- f SPC RET bus/ilc SPC new SPC RET 9*<C-n> C-e"))